diff --git a/.gitmodules b/.gitmodules index 1135585c1e..3529657d42 100644 --- a/.gitmodules +++ b/.gitmodules @@ -7,9 +7,9 @@ [submodule "carma"] path = src/physics/carma/base - url = https://github.com/fvitt/CARMA_base.git + url = https://github.com/ESCOMP/CARMA_base.git fxrequired = AlwaysRequired - fxtag = 4dbf023 + fxtag = carma4_09 fxDONOTUSEurl = https://github.com/ESCOMP/CARMA_base.git [submodule "pumas"] diff --git a/src/chemistry/aerosol/cloud_aqueous_chemistry.F90 b/src/chemistry/aerosol/cloud_aqueous_chemistry.F90 new file mode 100644 index 0000000000..301fef58f0 --- /dev/null +++ b/src/chemistry/aerosol/cloud_aqueous_chemistry.F90 @@ -0,0 +1,902 @@ +!---------------------------------------------------------------------------------- +! Cloud aqueous chemistry +! +! The purpose of this module is to calculate the sulfate formation due to various +! oxidation/condensation pathways of cloud chemistry. These pathways include: +! - SO2 oxidation by O3 +! - SO2 oxidation by H2O2 +! - H2SO4 condensation +! Updated gas and aqueous species concentrations along with cloud pH changes are +! calculated. +!---------------------------------------------------------------------------------- +module cloud_aqueous_chemistry + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + + ! Temporary to get CMake to pick up these dependencies + use bam_clouds, only : bam_id + use mam_clouds, only : mam_id + use carma_clouds, only : carma_id + + implicit none + + private + public :: initialize, calculate + public :: do_cloud_aqueous_chemistry + + logical :: do_cloud_aqueous_chemistry = .false. + + integer, parameter :: CLOUD_INDEX_UNDEFINED = -1 + + ! Cloud chemistry species information + type :: cloud_species_t + character(len=:), allocatable :: name_ + integer :: state_index_ = CLOUD_INDEX_UNDEFINED ! index in the state vector or the fixed concentrations array + logical :: is_constant_ = .false. + contains + procedure :: exists => cloud_species_exists + procedure :: mixing_ratio => cloud_species_get_mixing_ratio + end type cloud_species_t + + interface cloud_species_t + module procedure :: cloud_species_constructor + end interface cloud_species_t + + type(cloud_species_t) :: so2, nh3, hno3, h2o2, o3, ho2, msa, so4, h2so4 + + ! TODO: Figure out what this flag is for + logical :: cloud_borne = .false. + + ! Constants that should be moved to a common module + real(r8), parameter :: AVOGADRO = 6.023e23_r8 ! 6.02214129e23_r8 ! mol-1 + real(r8), parameter :: BOLTZMANN = 1.38e-23_r8 ! 1.380649e-23_r8 ! J K-1 + real(r8), parameter :: PASCAL_TO_ATM = 1.0_r8/101325.0_r8 + real(r8), parameter :: GAS_CONSTANT_L_ATM_MOL_K = 8314._r8*PASCAL_TO_ATM ! 8314.46261815324_r8*PASCAL_TO_ATM + real(r8), parameter :: GAS_CONSTANT_DRY_AIR_J_KG_K = 287.0_r8 ! J kg-1 K-1 + real(r8), parameter :: SMALL_NUMBER = 1.e-30_r8 ! unitless + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine initialize() + !----------------------------------------------------------------------- + ! ... prepare for cloud aqueous chemistry + ! - Look up cloud chemistry species + ! - Determine if enough species are present to perform cloud chemistry + !----------------------------------------------------------------------- + + use spmd_utils, only : masterproc + use phys_control, only : phys_getopts + use carma_flags_mod, only : carma_do_cloudborne +#ifdef USE_BAM + use bam_clouds, only : sox_cldaero_init +#endif +#ifdef USE_MAM + use mam_clouds, only : sox_cldaero_init +#endif +#ifdef USE_CARMA + use carma_clouds, only : sox_cldaero_init +#endif + + logical :: is_modal_aerosols + + call phys_getopts( prog_modal_aero_out=is_modal_aerosols ) + cloud_borne = is_modal_aerosols .or. carma_do_cloudborne + + so2 = cloud_species_t( 'SO2' ) + nh3 = cloud_species_t( 'NH3' ) + hno3 = cloud_species_t( 'HNO3' ) + h2o2 = cloud_species_t( 'H2O2' ) + o3 = cloud_species_t( 'O3' ) + ho2 = cloud_species_t( 'HO2' ) + msa = cloud_species_t( 'MSA' ) + so4 = cloud_species_t( 'SO4' ) + h2so4 = cloud_species_t( 'H2SO4' ) + + do_cloud_aqueous_chemistry = so2%exists() .and. h2o2%exists() .and. & + o3%exists() .and. ho2%exists() + if (do_cloud_aqueous_chemistry) then + if (cloud_borne) then + if (.not. h2so4%exists()) then + do_cloud_aqueous_chemistry = .false. + endif + else + if (.not. (so4%exists() .and. nh3%exists())) then + do_cloud_aqueous_chemistry = .false. + endif + endif + endif + + if (masterproc) then + if( do_cloud_aqueous_chemistry ) then + write(iulog,*) '-----------------------------------------' + write(iulog,*) ' cloud aqueous chemistry is active' + write(iulog,*) '-----------------------------------------' + else + write(iulog,*) '-----------------------------------------' + write(iulog,*) ' cloud aqueous chemistry is inactive' + write(iulog,*) '-----------------------------------------' + end if + end if + if (.not. do_cloud_aqueous_chemistry) return + + call sox_cldaero_init() + + end subroutine initialize + +!----------------------------------------------------------------------- +! Calculates the formation of sulfate and updates sulfate concentrations +! due to cloud aqueous chemistry. Also outputs the production rates +! (kg m-2 s-1) of various reactions of sulfur species with various +! oxidants (e.g., H2O2(aq), H2SO4(aq)). +!----------------------------------------------------------------------- + subroutine calculate( state, & + pbuf, & + ncol, & + lchnk, & + loffset, & + time_step, & + midpoint_pressure, & + pressure_thickness, & + temperature, & + mean_mass, & + cloud_water, & + cloud_fraction, & + cloud_droplet_number, & + air_number_density, & + fixed_concentrations, & + cloud_borne_aerosol_vmr, & + species_vmr, & + ph_times_cloud_water, & + aq_so4_production, & + aq_h2so4_production, & + aq_so4_production_from_h2o2, & + aq_so4_production_from_o3, & + specified_ph, & + aq_so4_production_from_h2o2_3d, & + aq_so4_production_from_o3_3d & + ) + + !----------------------------------------------------------------------- + ! ... Compute heterogeneous reactions of SOX + ! + ! (0) using initial PH to calculate PH + ! (a) HENRYs law constants + ! (b) PARTIONING + ! (c) PH values + ! + ! (1) using new PH to repeat + ! (a) HENRYs law constants + ! (b) PARTIONING + ! (c) REACTION rates + ! (d) PREDICTION + !----------------------------------------------------------------------- + ! + use ppgrid, only : pver +#ifdef USE_BAM + use bam_clouds, only : sox_cldaero_update, sox_cldaero_create_obj, & + sox_cldaero_destroy_obj +#endif +#ifdef USE_MAM + use mam_clouds, only : sox_cldaero_update, sox_cldaero_create_obj, & + sox_cldaero_destroy_obj +#endif +#ifdef USE_CARMA + use carma_clouds, only : sox_cldaero_update, sox_cldaero_create_obj, & + sox_cldaero_destroy_obj +#endif + use cloud_utilities, only : cldaero_conc_t + + ! + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer, intent(inout) :: pbuf(:) ! Physics buffer + integer, intent(in) :: ncol ! num of columns in chunk + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array + real(r8), intent(in) :: time_step ! time step (sec) + real(r8), intent(in) :: midpoint_pressure(:,:) ! midpoint pressure (Pa) + real(r8), intent(in) :: pressure_thickness(:,:) ! pressure thickness of levels (Pa) [pdel elsewhere in CAM] + real(r8), intent(in) :: temperature(:,:) ! temperature (K) [tfld elsewhere in CAM] + real(r8), intent(in) :: mean_mass(:,:) ! mean wet atmospheric mass (amu) + real(r8), target, intent(in) :: cloud_water(:,:) ! cloud liquid water content (kg/kg) + real(r8), target, intent(in) :: cloud_fraction(:,:) ! cloud fraction (unitless) + real(r8), intent(in) :: cloud_droplet_number(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: air_number_density(:,:) ! total atmospheric number density (/cm**3) + real(r8), intent(in) :: fixed_concentrations(:,:,:) ! fixed concentrations (/cm**3) [invariants elsewhere in CAM] + real(r8), target, intent(inout) :: cloud_borne_aerosol_vmr(:,:,:) ! cloud-borne aerosol (vmr) mol/mol = m3/m3 [qcw elsewhere in CAM] + real(r8), intent(inout) :: species_vmr(:,:,:) ! transported species (vmr) mol/mol = m3/m3 [qin elsewhere in CAM] + real(r8), intent(out) :: ph_times_cloud_water(:,:) ! pH value multiplied by cloud liquid water content + + real(r8), intent(out) :: aq_so4_production(:,:) ! aqueous phase production of SO4 (kg/m2/s) + real(r8), intent(out) :: aq_h2so4_production(:,:) ! aqueous phase production of H2SO4 (kg/m2/s) + real(r8), intent(out) :: aq_so4_production_from_h2o2(:) ! SO4 aqueous phase production due to H2O2 (kg/m2/s) + real(r8), intent(out) :: aq_so4_production_from_o3(:) ! SO4 aqueous phase production due to O3 (kg/m2/s) + real(r8), intent(in), optional :: specified_ph ! specified pH value. If present, this value will be used instead of calculated pH + real(r8), intent(out), optional :: aq_so4_production_from_h2o2_3d(:, :) ! 3D SO4 aqueous phase production due to H2O2 (kg/m2/s) + real(r8), intent(out), optional :: aq_so4_production_from_o3_3d(:, :) ! 3D SO4 aqueous phase production due to O3 (kg/m2/s) + + + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer, parameter :: MAX_ITERATIONS = 20 + real(r8), parameter :: INITIAL_PH = 5.0_r8 ! Initial pH value + real(r8), parameter :: MINIMUM_CLOUD_LIQUID_WATER = 1.e-8_r8 ! Minimum cloud liquid water content (kg/kg) + + ! Effective Henry's Law constants for HO2 partitioning + ! TODO: skipping remnaming of these in anticipation of a partitioning struct + real(r8), parameter :: kh0 = 9.e3_r8 ! HO2(g) -> Ho2(a) + real(r8), parameter :: kh1 = 2.05e-5_r8 ! HO2(a) -> H+ + O2- + real(r8), parameter :: kh2 = 8.6e5_r8 ! HO2(a) + ho2(a) -> h2o2(a) + o2 + real(r8), parameter :: kh3 = 1.e8_r8 ! HO2(a) + o2- -> h2o2(a) + o2 + + ! Water dissociation constant (mol2/L2) [H+][OH-] + real(r8), parameter :: water_dissociation_constant = 1.e-14_r8 + + ! Change in aqueous sulfate volume mixing ratio over current time step (mol mol-1) + real(r8) :: change_in_aq_so4_mixing_ratio(ncol,pver) + + ! TODO: Skipping renaming of these in anticipation of partitioning/pH estimation structs + integer :: k, i, iter + real(r8) :: xk, xe, x2 + real(r8) :: xl, px, patm + real(r8) :: Eso2, Eso4, Ehno3, Eco2, Eh2o, Enh3 + real(r8) :: so2g, h2o2g, co2g, o3g + real(r8) :: k_siv_h2o2 ! rate constant for reaction of S(IV) with H2O2 + real(r8) :: k_siv_o3 ! rate constant for reaction of S(IV) with O3 + real(r8) :: dso4_dt ! rate of change of SO4 + real(r8) :: delta_concentration + + real(r8) :: hno3g(ncol,pver), nh3g(ncol,pver) + ! + !----------------------------------------------------------------------- + ! for Ho2(g) -> H2o2(a) formation + ! schwartz JGR, 1984, 11589 + !----------------------------------------------------------------------- + real(r8) :: ho2s ! ho2s = ho2(a)+o2- + real(r8) :: dh2o2_dt_mol_L_s ! prod(h2o2) by ho2 in mole/L(w)/s + real(r8) :: dh2o2_dt_vmr_s ! prod(h2o2) by ho2 in mix/s + + ! volume mixing ratios for cloud chemistry species + real(r8), dimension(ncol,pver) :: xhno3, xh2o2, xso2, xso4, xno3, & + xnh3, xnh4, xo3, xph, xho2, xh2so4, xmsa, xso4_init + + real(r8), dimension(ncol,pver) :: air_mass_density_kg_l ! kg L-1 + + ! Effective Henry's Law constants + real(r8), dimension(ncol,pver) :: hehno3, heh2o2, heso2, henh3, heo3 + + ! TODO: Figure out what this actually represents (it differs based on the value of cloud_borne) + real(r8) :: patm_x + + real(r8), dimension(ncol) :: work1 + logical :: converged + + ! Cloud-borne species volume mixing ratios + real(r8), pointer :: xso4c(:,:) + real(r8), pointer :: xnh4c(:,:) + real(r8), pointer :: xno3c(:,:) + type(cldaero_conc_t), pointer :: cldconc + + ! TODO: Skipping renaming of these in anticipation of partitioning/pH estimation structs + real(r8) :: fact1_hno3, fact2_hno3, fact3_hno3 + real(r8) :: fact1_so2, fact2_so2, fact3_so2, fact4_so2 + real(r8) :: fact1_nh3, fact2_nh3, fact3_nh3 + real(r8) :: tmp_hp, tmp_hso3, tmp_hco3, tmp_nh4, tmp_no3 + real(r8) :: tmp_oh, tmp_so3, tmp_so4 + real(r8) :: tmp_neg, tmp_pos + real(r8) :: yph, yph_lo, yph_hi + real(r8) :: ynetpos, ynetpos_lo, ynetpos_hi + + !================================================================== + ! ... First set the PH + !================================================================== + ! ... Initial values + ! The values of so2, so4 are after (1) SLT, and CHEM + !----------------------------------------------------------------- + do k = 1,pver + air_mass_density_kg_l(:,k) = & + air_number_density(:,k) & ! molecules(air) cm-3 + * 1.e3_r8 & ! molecules(air) L-1 + * BOLTZMANN/GAS_CONSTANT_DRY_AIR_J_KG_K ! kg(air) L-1 + end do + + cldconc => sox_cldaero_create_obj( cloud_fraction, cloud_borne_aerosol_vmr, & + cloud_water, air_mass_density_kg_l, ncol, loffset ) + xso4c => cldconc%so4c + xnh4c => cldconc%nh4c + xno3c => cldconc%no3c + xso4(:,:) = 0._r8 + xno3(:,:) = 0._r8 + xnh4(:,:) = 0._r8 + call so2%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xso2 ) + call nh3%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xnh3 ) + call hno3%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xhno3 ) + call h2o2%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xh2o2 ) + call o3%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xo3 ) + call ho2%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xho2 ) + call msa%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xmsa ) + call so4%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xso4 ) + call h2so4%mixing_ratio( species_vmr, fixed_concentrations, air_number_density, xh2so4 ) + + xph(:,:) = 10._r8**(-INITIAL_PH) ! initial PH value + + !----------------------------------------------------------------- + ! ... Temperature dependent Henry constants + !----------------------------------------------------------------- + ver_loop0: do k = 1,pver !! pver loop for STEP 0 + col_loop0: do i = 1,ncol + + if (cloud_borne .and. cloud_fraction(i,k)>0._r8) then + xso4(i,k) = xso4c(i,k) / cloud_fraction(i,k) + xnh4(i,k) = xnh4c(i,k) / cloud_fraction(i,k) + xno3(i,k) = xno3c(i,k) / cloud_fraction(i,k) + endif + xl = cldconc%xlwc(i,k) + + if( xl >= MINIMUM_CLOUD_LIQUID_WATER ) then + work1(i) = 1._r8 / temperature(i,k) - 1._r8 / 298._r8 + + !----------------------------------------------------------------- + ! 21-mar-2011 changes by rce + ! ph calculation now uses bisection method to solve the electro-neutrality equation + ! 3-mode aerosols (where so4 is assumed to be nh4hso4) + ! old code set xnh4c = so4c + ! new code sets xnh4c = 0, then uses a -1 charge (instead of -2) + ! for so4 when solving the electro-neutrality equation + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! calculations done before iterating + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! This should be divided by 101325, not 101300, but fixing this breaks the tests + patm = midpoint_pressure(i,k)/101300._r8 + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + ! previous code + ! hehno3(i,k) = xk*(1._r8 + xe/xph(i,k)) + ! px = hehno3(i,k) * GAS_CONSTANT_L_ATM_MOL_K * tz * xl + ! hno3g = xhno3(i,k)/(1._r8 + px) + ! Ehno3 = xk*xe*hno3g *patm + ! equivalent new code + ! hehno3 = xk + xk*xe/hplus + ! hno3g = xhno3/(1 + px) + ! = xhno3/(1 + hehno3*ra*tz*xl) + ! = xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus) + ! ehno3 = hno3g*xk*xe*patm + ! = xk*xe*patm*xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus) + ! = ( fact1_hno3 )/(1 + fact2_hno3 *(1 + fact3_hno3/hplus) + ! [hno3-] = ehno3/hplus + xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) ) + xe = 15.4_r8 + fact1_hno3 = xk*xe*patm*xhno3(i,k) + fact2_hno3 = xk*GAS_CONSTANT_L_ATM_MOL_K*temperature(i,k)*xl + fact3_hno3 = xe + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + ! previous code + ! heso2(i,k) = xk*(1._r8 + wrk*(1._r8 + x2/xph(i,k))) + ! px = heso2(i,k) * GAS_CONSTANT_L_ATM_MOL_K * tz * xl + ! so2g = xso2(i,k)/(1._r8+ px) + ! Eso2 = xk*xe*so2g *patm + ! equivalent new code + ! heso2 = xk + xk*xe/hplus * xk*xe*x2/hplus**2 + ! so2g = xso2/(1 + px) + ! = xso2/(1 + heso2*ra*tz*xl) + ! = xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus)) + ! eso2 = so2g*xk*xe*patm + ! = xk*xe*patm*xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus)) + ! = ( fact1_so2 )/(1 + fact2_so2 *(1 + (fact3_so2/hplus)*(1 + fact4_so2/hplus) + ! [hso3-] + 2*[so3--] = (eso2/hplus)*(1 + 2*x2/hplus) + xk = 1.23_r8 *EXP( 3120._r8*work1(i) ) + xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) ) + x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) ) + fact1_so2 = xk*xe*patm*xso2(i,k) + fact2_so2 = xk*GAS_CONSTANT_L_ATM_MOL_K*temperature(i,k)*xl + fact3_so2 = xe + fact4_so2 = x2 + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + ! previous code + ! henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/water_dissociation_constant) + ! px = henh3(i,k) * GAS_CONSTANT_L_ATM_MOL_K * tz * xl + ! nh3g = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px) + ! Enh3 = xk*xe*nh3g/water_dissociation_constant *patm + ! equivalent new code + ! henh3 = xk + xk*xe*hplus/water_dissociation_constant + ! nh3g = xnh34/(1 + px) + ! = xnh34/(1 + henh3*ra*tz*xl) + ! = xnh34/(1 + xk*ra*tz*xl*(1 + xe*hplus/water_dissociation_constant) + ! enh3 = nh3g*xk*xe*patm/water_dissociation_constant + ! = ((xk*xe*patm/water_dissociation_constant)*xnh34)/ + ! (1 + xk*ra*tz*xl*(1 + xe*hplus/water_dissociation_constant) + ! = ( fact1_nh3 )/(1 + fact2_nh3 *(1 + fact3_nh3*hplus) + ! [nh4+] = enh3*hplus + xk = 58._r8 *EXP( 4085._r8*work1(i) ) + xe = 1.7e-5_r8*EXP( -4325._r8*work1(i) ) + + fact1_nh3 = (xk*xe*patm/water_dissociation_constant)*(xnh3(i,k)+xnh4(i,k)) + fact2_nh3 = xk*GAS_CONSTANT_L_ATM_MOL_K*temperature(i,k)*xl + fact3_nh3 = xe/water_dissociation_constant + + !----------------------------------------------------------------- + ! ... h2o effects + !----------------------------------------------------------------- + Eh2o = water_dissociation_constant + + !----------------------------------------------------------------- + ! ... co2 effects + !----------------------------------------------------------------- + co2g = 330.e-6_r8 !330 ppm = 330.e-6 atm + xk = 3.1e-2_r8*EXP( 2423._r8*work1(i) ) + xe = 4.3e-7_r8*EXP(-913._r8 *work1(i) ) + Eco2 = xk*xe*co2g *patm + + !----------------------------------------------------------------- + ! ... so4 effect + !----------------------------------------------------------------- + Eso4 = xso4(i,k)*air_number_density(i,k) & ! /cm3(a) + * (1.e3_r8/AVOGADRO) / xl + + + !----------------------------------------------------------------- + ! now use bisection method to solve electro-neutrality equation + ! + ! during the iteration loop, + ! yph_lo = lower ph value that brackets the root (i.e., correct ph) + ! yph_hi = upper ph value that brackets the root (i.e., correct ph) + ! yph = current ph value + ! yposnet_lo and yposnet_hi = net positive ions for + ! yph_lo and yph_hi + !----------------------------------------------------------------- + do iter = 1, MAX_ITERATIONS + + if (.not. present(specified_ph)) then + if (iter == 1) then + ! 1st iteration ph = lower bound value + yph_lo = 2.0_r8 + yph_hi = yph_lo + yph = yph_lo + else if (iter == 2) then + ! 2nd iteration ph = upper bound value + yph_hi = 7.0_r8 + yph = yph_hi + else + ! later iteration ph = mean of the two bracketing values + yph = 0.5_r8*(yph_lo + yph_hi) + end if + else + yph = specified_ph + end if + + ! calc current [H+] from ph + xph(i,k) = 10.0_r8**(-yph) + + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + Ehno3 = fact1_hno3/(1.0_r8 + fact2_hno3*(1.0_r8 + fact3_hno3/xph(i,k))) + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + Eso2 = fact1_so2/(1.0_r8 + fact2_so2*(1.0_r8 + (fact3_so2/xph(i,k)) & + *(1.0_r8 + fact4_so2/xph(i,k)))) + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + Enh3 = fact1_nh3/(1.0_r8 + fact2_nh3*(1.0_r8 + fact3_nh3*xph(i,k))) + + tmp_nh4 = Enh3 * xph(i,k) + tmp_hso3 = Eso2 / xph(i,k) + tmp_so3 = tmp_hso3 * 2.0_r8*fact4_so2/xph(i,k) + tmp_hco3 = Eco2 / xph(i,k) + tmp_oh = Eh2o / xph(i,k) + tmp_no3 = Ehno3 / xph(i,k) + tmp_so4 = cldconc%so4_fact*Eso4 + tmp_pos = xph(i,k) + tmp_nh4 + tmp_neg = tmp_oh + tmp_hco3 + tmp_no3 + tmp_hso3 + tmp_so3 + tmp_so4 + + ynetpos = tmp_pos - tmp_neg + + + ! yposnet = net positive ions/charge + ! if the correct ph is bracketed by yph_lo and yph_hi (with yph_lo < yph_hi), + ! then you will have yposnet_lo > 0 and yposnet_hi < 0 + converged = .false. + if (iter > 2) then + if (ynetpos == 0.0_r8) then + ! the exact solution was found (very unlikely) + tmp_hp = xph(i,k) + converged = .true. + exit + else if (ynetpos >= 0.0_r8) then + ! net positive ions are >= 0 for both yph and yph_lo + ! so replace yph_lo with yph + yph_lo = yph + ynetpos_lo = ynetpos + else + ! net positive ions are <= 0 for both yph and yph_hi + ! so replace yph_hi with yph + yph_hi = yph + ynetpos_hi = ynetpos + end if + + if (abs(yph_hi - yph_lo) .le. 0.005_r8) then + ! |yph_hi - yph_lo| <= convergence criterion, so set + ! final ph to their midpoint and exit + ! (.005 absolute error in pH gives .01 relative error in H+) + tmp_hp = xph(i,k) + yph = 0.5_r8*(yph_hi + yph_lo) + xph(i,k) = 10.0_r8**(-yph) + converged = .true. + exit + else + ! do another iteration + converged = .false. + end if + + else if (iter == 1) then + if (ynetpos <= 0.0_r8) then + ! the lower and upper bound ph values (2.0 and 7.0) do not bracket + ! the correct ph, so use the lower bound + tmp_hp = xph(i,k) + converged = .true. + exit + end if + ynetpos_lo = ynetpos + + else ! (iter == 2) + if (ynetpos >= 0.0_r8) then + ! the lower and upper bound ph values (2.0 and 7.0) do not bracket + ! the correct ph, so use they upper bound + tmp_hp = xph(i,k) + converged = .true. + exit + end if + ynetpos_hi = ynetpos + end if + + end do ! iter + + if( .not. converged ) then + write(iulog,*) 'setsox: pH failed to converge @ (',i,',',k,')' + end if + else + xph(i,k) = 1.e-7_r8 + end if + end do col_loop0 + end do ver_loop0 ! end pver loop for STEP 0 + + !============================================================== + ! ... Now use the actual PH + !============================================================== + ver_loop1: do k = 1,pver + col_loop1: do i = 1,ncol + work1(i) = 1._r8 / temperature(i,k) - 1._r8 / 298._r8 + xl = cldconc%xlwc(i,k) + + ! This should be dividing by 101325, not 101300, but changing it breaks the tests + patm = midpoint_pressure(i,k) / 101300._r8 ! press is in pascal + + !----------------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------------- + xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) ) + xe = 15.4_r8 + hehno3(i,k) = xk*(1._r8 + xe/xph(i,k)) + + !----------------------------------------------------------------- + ! ... h2o2 + !----------------------------------------------------------------- + xk = 7.4e4_r8 *EXP( 6621._r8*work1(i) ) + xe = 2.2e-12_r8 *EXP(-3730._r8*work1(i) ) + heh2o2(i,k) = xk*(1._r8 + xe/xph(i,k)) + + !----------------------------------------------------------------- + ! ... so2 + !----------------------------------------------------------------- + xk = 1.23_r8 *EXP( 3120._r8*work1(i) ) + xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) ) + x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) ) + + heso2(i,k) = xk*(1._r8 + xe/xph(i,k)*(1._r8 + x2/xph(i,k))) + + !----------------------------------------------------------------- + ! ... nh3 + !----------------------------------------------------------------- + xk = 58._r8 *EXP( 4085._r8*work1(i) ) + xe = 1.7e-5_r8*EXP(-4325._r8*work1(i) ) + henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/water_dissociation_constant) + + !----------------------------------------------------------------- + ! ... o3 + !----------------------------------------------------------------- + xk = 1.15e-2_r8 *EXP( 2560._r8*work1(i) ) + heo3(i,k) = xk + + !------------------------------------------------------------------------ + ! ... for Ho2(g) -> H2o2(a) formation + ! schwartz JGR, 1984, 11589 + !------------------------------------------------------------------------ + ho2s = kh0*xho2(i,k)*patm*(1._r8 + kh1/xph(i,k)) ! ho2s = ho2(a)+o2- + dh2o2_dt_mol_L_s = (kh2 + kh3*kh1/xph(i,k)) / ((1._r8 + kh1/xph(i,k))**2)*ho2s*ho2s ! prod(h2o2) in mole/L(w)/s + + if ( cloud_borne ) then + dh2o2_dt_vmr_s = dh2o2_dt_mol_L_s*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s + / (1.e3_r8/AVOGADRO)*1.e+6_r8 & ! correct a bug here ???? + / (midpoint_pressure(i,k)/(BOLTZMANN*temperature(i,k))) + else + dh2o2_dt_vmr_s = dh2o2_dt_mol_L_s*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s + * (1.e3_r8/AVOGADRO) & ! mole/fm3(a)/s * 1.e-3 = mole/cm3(a)/s + / (midpoint_pressure(i,k)/(BOLTZMANN*temperature(i,k))) ! /cm3(a)/s / air-den = mix-ratio/s + endif + + if ( .not. cloud_borne) then ! this seems to be specific to aerosols that are not cloud borne + xh2o2(i,k) = xh2o2(i,k) + dh2o2_dt_vmr_s*time_step ! updated h2o2 based on heterogeneous production + endif + + !----------------------------------------------- + ! ... Partioning + !----------------------------------------------- + + !----------------------------------------------------------------- + ! ... hno3 + !----------------------------------------------------------------- + px = hehno3(i,k) * GAS_CONSTANT_L_ATM_MOL_K * temperature(i,k) * xl + hno3g(i,k) = (xhno3(i,k)+xno3(i,k))/(1._r8 + px) + + !------------------------------------------------------------------------ + ! ... h2o2 + !------------------------------------------------------------------------ + px = heh2o2(i,k) * GAS_CONSTANT_L_ATM_MOL_K * temperature(i,k) * xl + h2o2g = xh2o2(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... so2 + !------------------------------------------------------------------------ + px = heso2(i,k) * GAS_CONSTANT_L_ATM_MOL_K * temperature(i,k) * xl + so2g = xso2(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... o3 + !------------------------------------------------------------------------ + px = heo3(i,k) * GAS_CONSTANT_L_ATM_MOL_K * temperature(i,k) * xl + o3g = xo3(i,k)/(1._r8+ px) + + !------------------------------------------------------------------------ + ! ... nh3 + !------------------------------------------------------------------------ + px = henh3(i,k) * GAS_CONSTANT_L_ATM_MOL_K * temperature(i,k) * xl + if (nh3%exists()) then + nh3g(i,k) = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px) + else + nh3g(i,k) = 0._r8 + endif + + !----------------------------------------------- + ! ... Aqueous phase reaction rates + ! SO2 + H2O2 -> SO4 + ! SO2 + O3 -> SO4 + !----------------------------------------------- + + !------------------------------------------------------------------------ + ! ... S(IV) (HSO3) + H2O2 + !------------------------------------------------------------------------ + k_siv_h2o2 = 8.e4_r8 * EXP( -3650._r8*work1(i) ) & + / (.1_r8 + xph(i,k)) + + !------------------------------------------------------------------------ + ! ... S(IV)+ O3 + !------------------------------------------------------------------------ + k_siv_o3 = 4.39e11_r8 * EXP(-4131._r8/temperature(i,k)) & + + 2.56e3_r8 * EXP(-996._r8 /temperature(i,k)) /xph(i,k) + + !----------------------------------------------------------------- + ! ... Prediction after aqueous phase + ! so4 + ! When Cloud is present + ! + ! S(IV) + H2O2 = S(VI) + ! S(IV) + O3 = S(VI) + ! + ! reference: + ! (1) Seinfeld + ! (2) Benkovitz + !----------------------------------------------------------------- + + !............................ + ! S(IV) + H2O2 = S(VI) + !............................ + + IF (XL .ge. MINIMUM_CLOUD_LIQUID_WATER) THEN !! WHEN CLOUD IS PRESENTED + + if (cloud_borne) then + patm_x = patm + else + patm_x = 1._r8 + endif + + if (cloud_borne) then + dso4_dt = k_siv_h2o2 * 7.4e4_r8*EXP(6621._r8*work1(i)) * h2o2g * patm_x & + * 1.23_r8 *EXP(3120._r8*work1(i)) * so2g * patm_x + else + dso4_dt = k_siv_h2o2 * heh2o2(i,k) * h2o2g * patm_x & + * heso2(i,k) * so2g * patm_x ! [M/s] + endif + + dso4_dt = dso4_dt & ! [M/s] = [mole/L(w)/s] + * xl & ! [mole/L(a)/s] + / (1.e3_r8/AVOGADRO) & ! [/L(a)/s] + / air_number_density(i,k) + + + delta_concentration = dso4_dt*time_step + delta_concentration = max(delta_concentration, SMALL_NUMBER) + + xso4_init(i,k)=xso4(i,k) + + IF (xh2o2(i,k) .gt. xso2(i,k)) THEN + if (delta_concentration .gt. xso2(i,k)) then + xso4(i,k)=xso4(i,k)+xso2(i,k) + if (cloud_borne) then + xh2o2(i,k)=xh2o2(i,k)-xso2(i,k) + xso2(i,k)=1.e-20_r8 ! TODO: See if SMALL_NUMBER is more appropriate + else ! ???? bug ???? + xso2(i,k)=1.e-20_r8 ! TODO: See if SMALL_NUMBER is more appropriate + xh2o2(i,k)=xh2o2(i,k)-xso2(i,k) + endif + else + xso4(i,k) = xso4(i,k) + delta_concentration + xh2o2(i,k) = xh2o2(i,k) - delta_concentration + xso2(i,k) = xso2(i,k) - delta_concentration + end if + + ELSE + if (delta_concentration .gt. xh2o2(i,k)) then + xso4(i,k)=xso4(i,k)+xh2o2(i,k) + xso2(i,k)=xso2(i,k)-xh2o2(i,k) + xh2o2(i,k)=1.e-20_r8 + else + xso4(i,k) = xso4(i,k) + delta_concentration + xh2o2(i,k) = xh2o2(i,k) - delta_concentration + xso2(i,k) = xso2(i,k) - delta_concentration + end if + END IF + + if (cloud_borne) then + change_in_aq_so4_mixing_ratio(i,k) = xso4(i,k) - xso4_init(i,k) + endif + !........................... + ! S(IV) + O3 = S(VI) + !........................... + + dso4_dt = k_siv_o3 * heo3(i,k)*o3g*patm_x * heso2(i,k)*so2g*patm_x ! [M/s] + + dso4_dt = dso4_dt & ! [M/s] = [mole/L(w)/s] + * xl & ! [mole/L(a)/s] + / (1.e3_r8/AVOGADRO) & ! [/L(a)/s] + / air_number_density(i,k) ! [mixing ratio/s] + + delta_concentration = dso4_dt*time_step + delta_concentration = max(delta_concentration, SMALL_NUMBER) + + xso4_init(i,k)=xso4(i,k) + + if (delta_concentration .gt. xso2(i,k)) then + xso4(i,k) = xso4(i,k) + xso2(i,k) + xso2(i,k) = 1.e-20_r8 ! TODO: See if SMALL_NUMBER is more appropriate + else + xso4(i,k) = xso4(i,k) + delta_concentration + xso2(i,k) = xso2(i,k) - delta_concentration + end if + + END IF !! WHEN CLOUD IS PRESENTED + + end do col_loop1 + end do ver_loop1 + + call sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, time_step, mean_mass, pressure_thickness, midpoint_pressure, temperature, cloud_droplet_number, cloud_fraction, air_mass_density_kg_l, cldconc%xlwc, & + change_in_aq_so4_mixing_ratio, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, cloud_borne_aerosol_vmr, species_vmr, & + aq_so4_production, aq_h2so4_production, aq_so4_production_from_h2o2, aq_so4_production_from_o3, aqso4_h2o2_3d=aq_so4_production_from_h2o2_3d, aqso4_o3_3d=aq_so4_production_from_o3_3d ) + + ph_times_cloud_water(:,:) = 0._r8 + do k = 1, pver + do i = 1, ncol + if (cloud_fraction(i,k)>=1.e-5_r8 .and. cloud_water(i,k)>=1.e-8_r8) then + ph_times_cloud_water(i,k) = -1._r8*log10(xph(i,k)) * cloud_water(i,k) + endif + end do + end do + + call sox_cldaero_destroy_obj(cldconc) + + end subroutine calculate + +!------------------------------------------------------------------------------- +! +! Support routines to be moved to separate modules +! +!------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + ! Creates a cloud species object with the given name + ! + ! The name is used to determine the species index in the state arrays. + ! If the species is not found, the index is set to CLOUD_INDEX_UNDEFINED. + function cloud_species_constructor( species_name ) result( this ) + + use mo_chem_utls, only : get_spc_ndx, get_inv_ndx + + type(cloud_species_t) :: this + character(len=*), intent(in) :: species_name + + this%name_ = species_name + this%state_index_ = get_inv_ndx( species_name ) + this%is_constant_ = this%state_index_ > 0 + if ( .not. this%is_constant_ ) & + this%state_index_ = get_spc_ndx( species_name ) + if ( this%state_index_ <= 0 ) this%state_index_ = CLOUD_INDEX_UNDEFINED + + end function cloud_species_constructor + + !------------------------------------------------------------------------------- + ! Returns whether a cloud species is defined + logical function cloud_species_exists( this ) + + class(cloud_species_t), intent(in) :: this + + cloud_species_exists = this%state_index_ .ne. CLOUD_INDEX_UNDEFINED + + end function cloud_species_exists + + !------------------------------------------------------------------------------- + ! Returns the mixing ratio for a cloud species + ! + ! Constant species use the fixed number concentration and the air density + ! to calculate the mixing ratio. Time-varying species simply return the + ! mixing ratio from the state array. + ! + ! For species that are not defined, the mixing ratio is set to zero. + subroutine cloud_species_get_mixing_ratio( this, mixing_ratios, & + fixed_concentrations, air_number_density, mixing_ratio ) + + class(cloud_species_t), intent(in) :: this + real(r8), intent(in) :: mixing_ratios(:,:,:) ! all mixing ratios (mol mol-1) [column, layer, species] + real(r8), intent(in) :: fixed_concentrations(:,:,:) ! all fixed concentrations (# cm-3) [column, layer, species] + real(r8), intent(in) :: air_number_density(:,:) ! air density (# cm-3) [column, layer] + real(r8), intent(out) :: mixing_ratio(:,:) ! species mixing ratio (mol mol-1) [column, layer] + + if ( this%state_index_ == CLOUD_INDEX_UNDEFINED ) then + mixing_ratio(:,:) = 0._r8 + return + end if + if ( this%is_constant_ ) then + mixing_ratio(:,:) = fixed_concentrations(:,:,this%state_index_) & + / air_number_density(:,:) + else + mixing_ratio(:,:) = mixing_ratios(:,:,this%state_index_) + end if + + end subroutine cloud_species_get_mixing_ratio + +end module cloud_aqueous_chemistry + diff --git a/src/chemistry/aerosol/cloud_aqueous_chemistry_snapshot.F90 b/src/chemistry/aerosol/cloud_aqueous_chemistry_snapshot.F90 new file mode 100644 index 0000000000..5781fc176b --- /dev/null +++ b/src/chemistry/aerosol/cloud_aqueous_chemistry_snapshot.F90 @@ -0,0 +1,152 @@ +! Captures inputs and output to cloud aqueous chemistry routines +module cloud_aqueous_chemistry_snapshot + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: cloud_snapshot_init, cloud_snapshot_capture_input, cloud_snapshot_capture_output + +contains + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine cloud_snapshot_init() + + use cam_history, only : addfld, horiz_only + + integer :: i_elem + character(len=10) :: index_string + + call addfld( 'cloud_press_in', (/ 'lev' /), 'I', 'Pa', 'mid-point pressure' ) + call addfld( 'cloud_pdel_in', (/ 'lev' /), 'I', 'Pa', 'pressure thickness of levels' ) + call addfld( 'cloud_tfld_in', (/ 'lev' /), 'I', 'K', 'temperature' ) + call addfld( 'cloud_mbar_in', (/ 'lev' /), 'I', 'AMU', 'mean wet atmopheric mass' ) + call addfld( 'cloud_lwc_in', (/ 'lev' /), 'I', 'kg kg-1', 'cloud liquid water content' ) + call addfld( 'cloud_cldfrc_in', (/ 'lev' /), 'I', 'unitless', 'cloud fraction' ) + call addfld( 'cloud_cldnum_in', (/ 'lev' /), 'I', 'kg-1', 'droplet number concentration' ) + call addfld( 'cloud_xhnm_in', (/ 'lev' /), 'I', 'cm-3', 'total atmospheric density' ) + do i_elem = 1, 7 + write(index_string, '(I10)') i_elem + call addfld( 'cloud_invariants_'//trim(adjustl(index_string))//'_in', (/ 'lev' /), 'I', 'unknown', 'invariant' ) + end do + do i_elem = 1, 26 + write(index_string, '(I10)') i_elem + call addfld( 'cloud_qcw_'//trim(adjustl(index_string))//'_in', (/ 'lev' /), 'I', 'vmr', 'cloud-borne aerosol' ) + call addfld( 'cloud_qcw_'//trim(adjustl(index_string))//'_out', (/ 'lev' /), 'I', 'vmr', 'transported species' ) + call addfld( 'cloud_qin_'//trim(adjustl(index_string))//'_in', (/ 'lev' /), 'I', 'vmr', 'transported species' ) + call addfld( 'cloud_qin_'//trim(adjustl(index_string))//'_out', (/ 'lev' /), 'I', 'vmr', 'transported species' ) + end do + call addfld( 'cloud_xphlwc_out', (/ 'lev' /), 'I', 'unitless', 'ph value multiplied by cloud liquid water content' ) + do i_elem = 1, 4 + write(index_string, '(I10)') i_elem + call addfld( 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', horiz_only, 'I', 'unknown', 'aqueous phase chemistry' ) + call addfld( 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', horiz_only, 'I', 'unknown', 'aqueous phase chemistry' ) + end do + call addfld( 'cloud_aqso4_h2o2_out', horiz_only, 'I', 'kg m-2', 'SO4 aqueous phase chemistry due to H2O2?' ) + call addfld( 'cloud_aqso4_o3_out', horiz_only, 'I', 'kg m-2', 'SO4 aqueous phase chemistry due to O3?' ) + + end subroutine cloud_snapshot_init + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine cloud_snapshot_capture_input(ncol, lchnk, loffset, dtime, press, & + pdel, tfld, mbar, lwc, cldfrc, cldnum, xhnm, invariants, qcw, qin) + + use cam_history, only : outfld + use cam_logfile, only : iulog + use spmd_utils, only : is_main_process => masterproc + + integer, intent(in) :: ncol ! num of columns in chunk + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array + real(r8), intent(in) :: dtime ! time step (sec) + real(r8), intent(in) :: press(:,:) ! midpoint pressure ( Pa ) + real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa) + real(r8), intent(in) :: tfld(:,:) ! temperature + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), target, intent(in) :: lwc(:,:) ! cloud liquid water content (kg/kg) + real(r8), target, intent(in) :: cldfrc(:,:) ! cloud fraction + real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) + real(r8), intent(in) :: xhnm(:,:) ! total atms density ( /cm**3) + real(r8), intent(in) :: invariants(:,:,:) + real(r8), target, intent(in) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(in) :: qin(:,:,:) ! transported species ( vmr ) + + integer :: i_elem + character(len=10) :: index_string + +#if 0 + if (is_main_process) then + write(iulog,*) "*****************************" + write(iulog,*) "Cloud Chemistry scalar inputs" + write(iulog,*) "*****************************" + write(iulog,*) "ncol: ", ncol + write(iulog,*) "lchnk: ", lchnk + write(iulog,*) "loffset: ", loffset + write(iulog,*) "dtime: ", dtime + write(iulog,*) "press dims: ", size(press, dim=1), size(press, dim=2) + write(iulog,*) "invariants dims: ", size(invariants, dim=1), size(invariants, dim=2), size(invariants, dim=3) + write(iulog,*) "qcw dims: ", size(qcw, dim=1), size(qcw, dim=2), size(qcw, dim=3) + write(iulog,*) "qin dims: ", size(qin, dim=1), size(qin, dim=2), size(qin, dim=3) + end if +#endif + call outfld( 'cloud_press_in', press(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_pdel_in', pdel(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_tfld_in', tfld(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_mbar_in', mbar(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_lwc_in', lwc(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_cldfrc_in', cldfrc(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_cldnum_in', cldnum(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_xhnm_in', xhnm(:ncol,:), ncol, lchnk ) + do i_elem = 1, 7 + write(index_string, '(I10)') i_elem + call outfld( 'cloud_invariants_'//trim(adjustl(index_string))//'_in', invariants(:ncol,:,i_elem), ncol, lchnk ) + end do + do i_elem = 1, 26 + write(index_string, '(I10)') i_elem + call outfld( 'cloud_qcw_'//trim(adjustl(index_string))//'_in', qcw(:ncol,:,i_elem), ncol, lchnk ) + call outfld( 'cloud_qin_'//trim(adjustl(index_string))//'_in', qin(:ncol,:,i_elem), ncol, lchnk ) + end do + + end subroutine cloud_snapshot_capture_input + +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + subroutine cloud_snapshot_capture_output(ncol, lchnk, qcw, qin, xphlwc, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3) + + use cam_history, only : outfld + + integer, intent(in) :: ncol ! num of columns in chunk + integer, intent(in) :: lchnk ! chunk id + real(r8), target, intent(in) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(in) :: qin(:,:,:) ! transported species ( vmr ) + real(r8), intent(in) :: xphlwc(:,:) ! pH value multiplied by lwc + + real(r8), intent(in) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(in) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(in) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(in) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + integer :: i_elem + character(len=10) :: index_string + + call outfld( 'cloud_xphlwc_out', xphlwc(:ncol,:), ncol, lchnk ) + call outfld( 'cloud_aqso4_h2o2_out', aqso4_h2o2(:ncol), ncol, lchnk ) + call outfld( 'cloud_aqso4_o3_out', aqso4_o3(:ncol), ncol, lchnk ) + do i_elem = 1, 4 + write(index_string, '(I10)') i_elem + call outfld( 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', aqso4(:ncol,i_elem), ncol, lchnk ) + call outfld( 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', aqh2so4(:ncol,i_elem), ncol, lchnk ) + end do + do i_elem = 1, 26 + write(index_string, '(I10)') i_elem + call outfld( 'cloud_qcw_'//trim(adjustl(index_string))//'_out', qcw(:ncol,:,i_elem), ncol, lchnk ) + call outfld( 'cloud_qin_'//trim(adjustl(index_string))//'_out', qin(:ncol,:,i_elem), ncol, lchnk ) + end do + + end subroutine cloud_snapshot_capture_output + +end module cloud_aqueous_chemistry_snapshot \ No newline at end of file diff --git a/src/chemistry/aerosol/cloud_utilities.F90 b/src/chemistry/aerosol/cloud_utilities.F90 new file mode 100644 index 0000000000..a92ee7cfc5 --- /dev/null +++ b/src/chemistry/aerosol/cloud_utilities.F90 @@ -0,0 +1,149 @@ +!---------------------------------------------------------------------------------- +! low level utility module for cloud aerosols +! +! Created by Francis Vitt +!---------------------------------------------------------------------------------- +module cloud_utilities + + use shr_kind_mod, only : r8 => shr_kind_r8 + use ppgrid, only : pcols, pver + + implicit none + private + + public :: cldaero_uptakerate + public :: cldaero_conc_t + public :: cldaero_allocate + public :: cldaero_deallocate + + type cldaero_conc_t + real(r8), pointer :: so4c(:,:) + real(r8), pointer :: nh4c(:,:) + real(r8), pointer :: no3c(:,:) + real(r8), pointer :: xlwc(:,:) + real(r8) :: so4_fact + end type cldaero_conc_t + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function cldaero_allocate( ) result( cldconc ) + type(cldaero_conc_t), pointer:: cldconc + + allocate( cldconc ) + allocate( cldconc%so4c(pcols,pver) ) + allocate( cldconc%nh4c(pcols,pver) ) + allocate( cldconc%no3c(pcols,pver) ) + allocate( cldconc%xlwc(pcols,pver) ) + + cldconc%so4c(:,:) = 0._r8 + cldconc%nh4c(:,:) = 0._r8 + cldconc%no3c(:,:) = 0._r8 + cldconc%xlwc(:,:) = 0._r8 + cldconc%so4_fact = 2._r8 + + end function cldaero_allocate + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + subroutine cldaero_deallocate( cldconc ) + type(cldaero_conc_t), pointer :: cldconc + + if ( associated(cldconc%so4c) ) then + deallocate(cldconc%so4c) + nullify(cldconc%so4c) + endif + + if ( associated(cldconc%nh4c) ) then + deallocate(cldconc%nh4c) + nullify(cldconc%nh4c) + endif + + if ( associated(cldconc%no3c) ) then + deallocate(cldconc%no3c) + nullify(cldconc%no3c) + endif + + if ( associated(cldconc%xlwc) ) then + deallocate(cldconc%xlwc) + nullify(cldconc%xlwc) + endif + + deallocate( cldconc ) + nullify( cldconc ) + + end subroutine cldaero_deallocate + +!---------------------------------------------------------------------------------- +! utility function for cloud-borne aerosols +!---------------------------------------------------------------------------------- + + function cldaero_uptakerate( xl, cldnum, cfact, cldfrc, tfld, press ) result( uptkrate ) + use mo_constants, only : pi + + real(r8), intent(in) :: xl, cldnum, cfact, cldfrc, tfld, press + + real(r8) :: uptkrate + + real(r8) :: & + rad_cd, radxnum_cd, num_cd, & + gasdiffus, gasspeed, knudsen, & + fuchs_sutugin, volx34pi_cd + +!----------------------------------------------------------------------- +! compute uptake of h2so4 and msa to cloud water +! +! first-order uptake rate is +! 4*pi*(drop radius)*(drop number conc) +! *(gas diffusivity)*(fuchs sutugin correction) + +! num_cd = (drop number conc in 1/cm^3) + num_cd = 1.0e-3_r8*cldnum*cfact/cldfrc + num_cd = max( num_cd, 0.0_r8 ) + +! rad_cd = (drop radius in cm), computed from liquid water and drop number, +! then bounded by 0.5 and 50.0 micrometers +! radxnum_cd = (drop radius)*(drop number conc) +! volx34pi_cd = (3/4*pi) * (liquid water volume in cm^3/cm^3) + + volx34pi_cd = xl*0.75_r8/pi + +! following holds because volx34pi_cd = num_cd*(rad_cd**3) + radxnum_cd = (volx34pi_cd*num_cd*num_cd)**0.3333333_r8 + +! apply bounds to rad_cd to avoid the occasional unphysical value + if (radxnum_cd .le. volx34pi_cd*4.0e4_r8) then + radxnum_cd = volx34pi_cd*4.0e4_r8 + rad_cd = 50.0e-4_r8 + else if (radxnum_cd .ge. volx34pi_cd*4.0e8_r8) then + radxnum_cd = volx34pi_cd*4.0e8_r8 + rad_cd = 0.5e-4_r8 + else + rad_cd = radxnum_cd/num_cd + end if + +! gasdiffus = h2so4 gas diffusivity from mosaic code (cm^2/s) +! (pmid must be Pa) + gasdiffus = 0.557_r8 * (tfld**1.75_r8) / press + +! gasspeed = h2so4 gas mean molecular speed from mosaic code (cm/s) + gasspeed = 1.455e4_r8 * sqrt(tfld/98.0_r8) + +! knudsen number + knudsen = 3.0_r8*gasdiffus/(gasspeed*rad_cd) + +! following assumes accomodation coefficient = 0.65 +! (Adams & Seinfeld, 2002, JGR, and references therein) +! fuchs_sutugin = (0.75*accom*(1. + knudsen)) / +! (knudsen*(1.0 + knudsen + 0.283*accom) + 0.75*accom) + fuchs_sutugin = (0.4875_r8*(1._r8 + knudsen)) / & + (knudsen*(1.184_r8 + knudsen) + 0.4875_r8) + +! instantaneous uptake rate + uptkrate = 12.56637_r8*radxnum_cd*gasdiffus*fuchs_sutugin + + end function cldaero_uptakerate + +end module cloud_utilities + diff --git a/src/chemistry/bulk_aero/bam_clouds.F90 b/src/chemistry/bulk_aero/bam_clouds.F90 new file mode 100644 index 0000000000..c11ce7ce49 --- /dev/null +++ b/src/chemistry/bulk_aero/bam_clouds.F90 @@ -0,0 +1,151 @@ +!---------------------------------------------------------------------------------- +! Bulk aerosol implementation +!---------------------------------------------------------------------------------- +module bam_clouds + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cloud_utilities, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate + use physics_buffer, only : physics_buffer_desc + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_so2, id_so4, id_h2o2 + + real(r8), parameter :: small_value = 1.e-20_r8 + + integer, parameter, public :: bam_id = 1 + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + id_so2 = get_spc_ndx( 'SO2' ) + id_so4 = get_spc_ndx( 'SO4' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + + if ( id_so2<1 ) then + call endrun('sox_cldaero_init: SO2 is not included in chemistry -- should not invoke sox_cldaero_mod...') + endif + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + type(cldaero_conc_t), pointer :: conc_obj + + conc_obj => cldaero_allocate() + + conc_obj%xlwc(:ncol,:) = lwc(:ncol,:)*cfact(:ncol,:) ! cloud water L(water)/L(air) + + end function sox_cldaero_create_obj + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d ) + use physics_types, only: physics_state + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + ! local vars ... + + integer :: k + + ! FUTURE_ANSWER_CHANGING_UPDATE + ! The aqueous chemistry variables are intent out, but they are not + ! actually calculated in this subroutine. + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + do k = 1,pver + + if (id_so2>0) then + qin(:,k,id_so2) = MAX( xso2(:,k), small_value ) + endif + if (id_h2o2>0) then + qin(:,k,id_h2o2)= MAX( xh2o2(:,k), small_value ) + endif + + qin(:,k,id_so4) = MAX( xso4(:,k), small_value ) + + end do + + end subroutine sox_cldaero_update + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module bam_clouds diff --git a/src/chemistry/carma_aero/carma_clouds.F90 b/src/chemistry/carma_aero/carma_clouds.F90 new file mode 100644 index 0000000000..082f47a186 --- /dev/null +++ b/src/chemistry/carma_aero/carma_clouds.F90 @@ -0,0 +1,532 @@ +!---------------------------------------------------------------------------------- +! CARMA implementation of cloud chemistry +!---------------------------------------------------------------------------------- +module carma_clouds + + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, dtype_r8 + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cloud_utilities, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate, cldaero_uptakerate + use cam_logfile, only : iulog + !st use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode + !st use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode + !st use modal_aero_data, only : cnst_name_cw, specmw_so4_amode + use chem_mods, only : adv_mass + use physconst, only : gravit + use phys_control, only : phys_getopts + use chem_mods, only : gas_pcnst + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx + use spmd_utils, only: masterproc + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_msa, id_h2so4, id_so2, id_h2o2, id_nh3 + + real(r8), parameter :: small_value = 1.e-20_r8 + + ! description of bin aerosols + integer, public, protected :: nspec_max = 0 + integer, public, protected :: nbins = 0 + integer, public, protected, allocatable :: nspec(:) + + ! local indexing for bins + integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + integer :: ncnst_tot ! total number of mode number conc + mode species + + integer, parameter, public :: carma_id = 2 + +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + integer :: l, m, mm, ii + logical :: history_aerosol ! Output the MAM aerosol tendencies + + id_msa = get_spc_ndx( 'MSA' ) + id_h2so4 = get_spc_ndx( 'H2SO4' ) + id_so2 = get_spc_ndx( 'SO2' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + id_nh3 = get_spc_ndx( 'NH3' ) + + if (id_h2so4<1 .or. id_so2<1 .or. id_h2o2<1) then + call endrun('sox_cldaero_init:MAM mech does not include necessary species' & + //' -- should not invoke sox_cldaero_mod ') + endif + + call phys_getopts( history_aerosol_out = history_aerosol ) + ! + ! add to history + ! + + ! get info about the modal aerosols + ! get nbins + + call rad_cnst_get_info( 0, nbins=nbins) + + if (allocated(nspec)) deallocate( nspec ) + allocate( nspec(nbins) ) + + do m = 1, nbins + call rad_cnst_get_info_by_bin(0, m, nspec=nspec(m)) + end do + ! add plus one to include number, total mmr and nspec + nspec_max = maxval(nspec) + + ncnst_tot = nspec(1) + do m = 2, nbins + ncnst_tot = ncnst_tot + nspec(m) + end do + + if (allocated(bin_idx)) deallocate( bin_idx ) + allocate( bin_idx(nbins,nspec_max) ) + + + ! Local indexing compresses the mode and number/mass indicies into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. + ! for CARMA we add number = 0, total mass = 1, and mass from each constituence into mm. + ii = 0 + do m = 1, nbins + do l = 1, nspec(m) ! loop through species + ii = ii + 1 + bin_idx(m,l) = ii + end do + end do + + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + real(r8) :: so4mmr(pcols,pver) + real(r8) :: nitmmr(pcols,pver) + + type(cldaero_conc_t), pointer :: conc_obj + + character(len=32) :: spectype + + integer :: l,n,m + integer :: i,k,mm + + ! local indexing for bins + !integer, allocatable :: bin_idx(:,:) ! table for local indexing of modal aero number and mmr + + + conc_obj => cldaero_allocate() + + do k = 1,pver + do i = 1,ncol + if( cldfrc(i,k) >0._r8) then + conc_obj%xlwc(i,k) = lwc(i,k) *cfact(i,k) ! cloud water L(water)/L(air) + conc_obj%xlwc(i,k) = conc_obj%xlwc(i,k) / cldfrc(i,k) ! liquid water in the cloudy fraction of cell + else + conc_obj%xlwc(i,k) = 0._r8 + endif + enddo + enddo + + conc_obj%no3c(:,:) = 0._r8 + conc_obj%nh4c(:,:) = 0._r8 + conc_obj%so4c(:,:) = 0._r8 + + so4mmr(:,:) = 0._r8 + do k = 1,pver + do i = 1,ncol + do m = 1, nbins + do l = 1, nspec(m) + mm = bin_idx(m, l) + call rad_cnst_get_bin_props_by_idx(0, m, l,spectype=spectype) + if (trim(spectype) == 'sulfate') then + so4mmr(i,k) = so4mmr(i,k) + qcw(i,k,mm) + end if + end do + end do + end do + end do + conc_obj%so4c = so4mmr + + end function sox_cldaero_create_obj + + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) + + use aerosol_properties_mod, only: aero_name_len + use physics_types, only: physics_state + use carma_intr, only: carma_get_group_by_name, carma_get_dry_radius + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) vmrcw(ncol,pver,ncnst_tot) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + ! local vars ... + real(r8) :: dryr(pcols,pver) ! CARMA dry radius in cm + real(r8) :: rho(pcols,pver) ! + real(r8) :: dryr_n(nbins,ncol,pver) ! CARMA dry radius in cm + real(r8) :: dqdt_aqso4(ncol,pver,ncnst_tot), & + dqdt_aqh2so4(ncol,pver,ncnst_tot), & + dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), & + sflx(1:ncol) + + real(r8) :: faqgain_msa(nbins), faqgain_so4(nbins) + real(r8) :: wt_mass(nbins) + + real(r8) :: delso4_o3rxn, & + dso4dt_aqrxn, dso4dt_hprxn, & + dso4dt_gasuptk, dmsadt_gasuptk, & + dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, & + dqdt_aq, dqdt_wr, dqdt + + real(r8) :: fwetrem, sumf, uptkrate + real(r8) :: delnh3, delnh4 + + integer :: l, n, m, mm + integer :: ntot_msa_c + + integer :: i,k + real(r8) :: xl + real(r8) :: wt_sum + real(r8) :: specmw_so4_amode + + character(len=32) :: spectype + + character(len=*), parameter :: subname = 'sox_cldaero_update' + character(len=aero_name_len) :: bin_name, shortname + integer :: igroup, ibin, rc, nchr + + ! make sure dqdt is zero initially, for budgets + dqdt_aqso4(:,:,:) = 0.0_r8 + dqdt_aqh2so4(:,:,:) = 0.0_r8 + dqdt_aqhprxn(:,:) = 0.0_r8 + dqdt_aqo3rxn(:,:) = 0.0_r8 + dryr_n(:,:,:) = 0.0_r8 + + ntot_msa_c = 0.0_r8 + aqso4 = 0.0_r8 + aqh2so4 = 0.0_r8 + aqso4_h2o2 = 0.0_r8 + aqso4_o3 = 0.0_r8 + + do n = 1, nbins + call rad_cnst_get_info_by_bin(0, n, nspec=nspec(n), bin_name=bin_name) + + + nchr = len_trim(bin_name)-2 + shortname = bin_name(:nchr) + + call carma_get_group_by_name(shortname, igroup, rc) + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_group_by_name') + end if + + read(bin_name(nchr+1:),*) ibin + + call carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + if (rc/=0) then + call endrun(subname//': ERROR in carma_get_dry_radius') + end if + + dryr(:ncol,:) = dryr(:ncol,:)*1.e2_r8 ! cm + + if (index(bin_name,'MXAER')>0) then + dryr_n(n,:ncol,:) = dryr(:ncol,:) + end if + end do + + lev_loop: do k = 1,pver + col_loop: do i = 1,ncol + cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then + xl = xlwc(i,k) ! / cldfrc(i,k) + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + delso4_o3rxn = xso4(i,k) - xso4_init(i,k) + !write(iulog,*) 'delso4_o3rxn ', delso4_o3rxn + + !st if (id_nh3>0) then + !st delnh3 = nh3g(i,k) - xnh3(i,k) + !st delnh4 = - delnh3 + !st endif + + ! the factors are proportional to the activated particle MR for each + ! bin, which is the MR of cloud drops "associated with" the mode + ! thus we are assuming the cloud drop size is independent of the + ! associated aerosol mode properties (i.e., drops associated with + ! Aitken and coarse sea-salt particles are same size) + ! + ! qnum_c(n) = activated particle number MR for mode n (these are just + ! used for partitioning among modes, so don't need to divide by cldfrc) + + !faqgain_so4(n) = fraction of total so4_c gain going to mode n + wt_sum = 0._r8 + wt_mass(:) = 0._r8 + faqgain_so4(:) = 0.0_r8 + do n = 1, nbins + if (dryr_n(n,i,k) > 0._r8) then + wt_mass(n) = delso4_o3rxn / dryr_n(n,i,k) / dryr_n(n,i,k) + wt_sum = wt_sum + wt_mass(n) + end if + end do + do n = 1, nbins + if (wt_mass(n) > 0._r8) then + faqgain_so4(n) = wt_mass(n)/wt_sum + end if + end do + + ! at this point (sumf <= 0.0) only when all the faqgain_msa are zero + uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) ) + ! average uptake rate over dtime + uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime + + ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s) + ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s) + dso4dt_gasuptk = xh2so4(i,k) * uptkrate + !if (id_msa > 0) then + ! dmsadt_gasuptk = xmsa(i,k) * uptkrate + !else + ! dmsadt_gasuptk = 0.0_r8 + !end if +! + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 + dmsadt_gasuptk_toso4 = 0.0_r8 + !st dmsadt_gasuptk_tomsa = dmsadt_gasuptk + !st if (ntot_msa_c == 0) then + !st dmsadt_gasuptk_tomsa = 0.0_r8 + !st dmsadt_gasuptk_toso4 = dmsadt_gasuptk + !st end if + + !----------------------------------------------------------------------- + ! now compute TMR tendencies + ! this includes the above aqueous so2 chemistry AND + ! the uptake of highly soluble aerosol precursor gases (h2so4, msa, ...) + ! AND the wetremoval of dissolved, unreacted so2 and h2o2 + + dso4dt_aqrxn = (delso4_o3rxn + delso4_hprxn(i,k)) / dtime + dso4dt_hprxn = delso4_hprxn(i,k) / dtime + !write(iulog,*) 'dso4dt_aqrxn ',dso4dt_aqrxn + + ! fwetrem = fraction of in-cloud-water material that is wet removed + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't have so4 & msa wet removal here + + ! compute TMR tendencies for so4, not done currently for msa aerosol-in-cloud-water + do n = 1, nbins + do l = 1, nspec(n) + mm = bin_idx(n, l) + call rad_cnst_get_bin_props_by_idx(0, n, l,spectype=spectype) + if (trim(spectype) == 'sulfate') then + if (faqgain_so4(n) .gt. 0.0_r8) then + dqdt_aqso4(i,k,mm) = faqgain_so4(n)*dso4dt_aqrxn*cldfrc(i,k) + + dqdt_aqh2so4(i,k,mm) = faqgain_so4(n)* & + (dso4dt_gasuptk + dmsadt_gasuptk_toso4)*cldfrc(i,k) + dqdt_aq = dqdt_aqso4(i,k,mm) + dqdt_aqh2so4(i,k,mm) + dqdt_wr = -fwetrem*dqdt_aq + dqdt= dqdt_aq + dqdt_wr + !write(iulog,*) 'qcw(i,k,mm) before ', m, qcw(i,k,mm) + qcw(i,k,mm) = qcw(i,k,mm) + dqdt*dtime + !write(iulog,*) 'qcw(i,k,mm) after', m, qcw(i,k,mm) + end if + end if + end do + end do + + + ! For gas species, tendency includes + ! reactive uptake to cloud water that essentially transforms the gas to + ! a different species. Wet removal associated with this is applied + ! to the "new" species (e.g., so4_c) rather than to the gas. + ! wet removal of the unreacted gas that is dissolved in cloud water. + ! Need to multiply both these parts by cldfrc + + ! h2so4 (g) & msa (g) + + !H2SO4 not updated in Pengfei's model + !st TEST with H2SO4 uptake + qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k) + !qin(i,k,id_h2so4) = MAX( qin(i,k,id_h2so4), small_value ) + + !st if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k) + + ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include so2 wet removal here + + dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + dqdt = dqdt_aq + qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime + qin(i,k,id_so2) = MAX( qin(i,k,id_so2), small_value ) + + ! h2o2 -- the first order loss rate for h2o2 is frh2o2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frh2o2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include h2o2 wet removal here + + dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_hprxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + dqdt = dqdt_aq + qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime + qin(i,k,id_h2o2) = MAX( qin(i,k,id_h2o2), small_value ) + + ! NH3 + !st if (id_nh3>0) then + !st dqdt_aq = delnh3/dtime*cldfrc(i,k) + !st dqdt = dqdt_aq + !st qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime + !st endif + + ! for SO4 from H2O2/O3 budgets + dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k) + dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k) + + + ENDIF !! WHEN CLOUD IS PRESENTED + endif cloud + enddo col_loop + enddo lev_loop + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + + ! diagnostics + + specmw_so4_amode = 96.0_r8 + do n = 1, nbins + ! while looking through all species, only dqdt_aqso4 from sulfates is gt zero + do l = 1, nspec(n) + mm = bin_idx(n, l) + aqso4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqso4(i,n)=aqso4(i,n)+dqdt_aqso4(i,k,mm)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + + aqh2so4(:,n)=0._r8 + do k=1,pver + do i=1,ncol + aqh2so4(i,n)=aqh2so4(i,n)+dqdt_aqh2so4(i,k,mm)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + end do + end do + + aqso4_h2o2(:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2(i)=aqso4_h2o2(i)+dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_h2o2_3d)) then + aqso4_h2o2_3d(:,:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2_3d(i,k)=dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + aqso4_o3(:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3(i)=aqso4_o3(i)+dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_o3_3d)) then + aqso4_o3_3d(:,:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3_3d(i,k)=dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + end subroutine sox_cldaero_update + + !---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module carma_clouds + diff --git a/src/chemistry/carma_aero/sox_cldaero_mod.F90 b/src/chemistry/carma_aero/sox_cldaero_mod.F90 index 385e121424..65e04ff5e5 100644 --- a/src/chemistry/carma_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/carma_aero/sox_cldaero_mod.F90 @@ -3,7 +3,7 @@ !---------------------------------------------------------------------------------- module sox_cldaero_mod - use physics_buffer, only : physics_buffer_desc, pbuf_get_index, pbuf_get_field, dtype_r8 + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, dtype_r8 use shr_kind_mod, only : r8 => shr_kind_r8 use cam_abortutils, only : endrun use ppgrid, only : pcols, pver @@ -73,6 +73,7 @@ subroutine sox_cldaero_init call rad_cnst_get_info( 0, nbins=nbins) + if (allocated(nspec)) deallocate( nspec ) allocate( nspec(nbins) ) do m = 1, nbins @@ -86,6 +87,7 @@ subroutine sox_cldaero_init ncnst_tot = ncnst_tot + nspec(m) end do + if (allocated(bin_idx)) deallocate( bin_idx ) allocate( bin_idx(nbins,nspec_max) ) diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 3d240285ad..9f2973d70d 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -187,6 +187,7 @@ subroutine aero_model_init( pbuf2d ) use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init use modal_aero_newnuc, only: modal_aero_newnuc_init use modal_aero_rename, only: modal_aero_rename_init + use cloud_aqueous_chemistry_snapshot, only : cloud_snapshot_init ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -544,6 +545,8 @@ subroutine aero_model_init( pbuf2d ) call aero_wetdep_init() + call cloud_snapshot_init() + end subroutine aero_model_init !============================================================================= @@ -960,7 +963,8 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re use modal_aero_gasaerexch, only : modal_aero_gasaerexch_sub use modal_aero_newnuc, only : modal_aero_newnuc_sub use modal_aero_data, only : cnst_name_cw, qqcw_get_field - + use cloud_aqueous_chemistry_snapshot, only : cloud_snapshot_capture_input, & + cloud_snapshot_capture_output !----------------------------------------------------------------------- ! ... dummy arguments !----------------------------------------------------------------------- @@ -1060,7 +1064,29 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! aqueous chemistry ... - + call cloud_snapshot_capture_input( & + ! pbuf, & + ncol, & + lchnk, & + loffset, & + delt, & + pmid, & + pdel, & + tfld, & + mbar, & + cwat, & + cldfr, & + cldnum, & + airdens, & + invariants, & + vmrcw, & + vmr & + ! xphlwc, & + ! aqso4, & + ! aqh2so4, & + ! aqso4_h2o2, & + ! aqso4_o3 & + ) if( has_sox ) then call setsox( state, & pbuf, & @@ -1099,6 +1125,29 @@ subroutine aero_model_gasaerexch( state, loffset, ncol, lchnk, troplev, delt, re call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk ) endif + call cloud_snapshot_capture_output( & + ! pbuf, & + ncol, & + lchnk, & + ! loffset, & + ! delt, & + ! pmid, & + ! pdel, & + ! tfld, & + ! mbar, & + ! cwat, & + ! cldfr, & + ! cldnum, & + ! airdens, & + ! invariants, & + vmrcw, & + vmr, & + xphlwc, & + aqso4, & + aqh2so4, & + aqso4_h2o2, & + aqso4_o3 & + ) ! Tendency due to aqueous chemistry dvmrdt = (vmr - dvmrdt) / delt diff --git a/src/chemistry/modal_aero/mam_clouds.F90 b/src/chemistry/modal_aero/mam_clouds.F90 new file mode 100644 index 0000000000..991b509dc6 --- /dev/null +++ b/src/chemistry/modal_aero/mam_clouds.F90 @@ -0,0 +1,531 @@ +!---------------------------------------------------------------------------------- +! Modal aerosol implementation of cloud chemistry +!---------------------------------------------------------------------------------- +module mam_clouds + + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_abortutils, only : endrun + use ppgrid, only : pcols, pver + use mo_chem_utls, only : get_spc_ndx + use cloud_utilities, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate, cldaero_uptakerate + use modal_aero_data, only : ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode + use modal_aero_data, only : numptrcw_amode, lptr_nh4_cw_amode + use modal_aero_data, only : cnst_name_cw, specmw_so4_amode + use chem_mods, only : adv_mass + use physconst, only : gravit + use phys_control, only : phys_getopts, cam_chempkg_is + use chem_mods, only : gas_pcnst + use physics_buffer, only : physics_buffer_desc + + implicit none + private + + public :: sox_cldaero_init + public :: sox_cldaero_create_obj + public :: sox_cldaero_update + public :: sox_cldaero_destroy_obj + + integer :: id_msa, id_h2so4, id_so2, id_h2o2, id_nh3 + + real(r8), parameter :: small_value = 1.e-20_r8 + + integer, parameter, public :: mam_id = 3 +contains + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + + subroutine sox_cldaero_init + + integer :: l, m + logical :: history_aerosol ! Output the MAM aerosol tendencies + + id_msa = get_spc_ndx( 'MSA' ) + id_h2so4 = get_spc_ndx( 'H2SO4' ) + id_so2 = get_spc_ndx( 'SO2' ) + id_h2o2 = get_spc_ndx( 'H2O2' ) + id_nh3 = get_spc_ndx( 'NH3' ) + + if (id_h2so4<1 .or. id_so2<1 .or. id_h2o2<1) then + call endrun('sox_cldaero_init:MAM mech does not include necessary species' & + //' -- should not invoke sox_cldaero_mod ') + endif + + call phys_getopts( history_aerosol_out = history_aerosol ) + ! + ! add to history + ! + + end subroutine sox_cldaero_init + +!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- + function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj ) + + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: qcw(:,:,:) + real(r8), intent(in) :: lwc(:,:) + real(r8), intent(in) :: cfact(:,:) + integer, intent(in) :: ncol + integer, intent(in) :: loffset + + type(cldaero_conc_t), pointer :: conc_obj + + + integer :: id_so4_1a, id_so4_2a, id_so4_3a, id_so4_4a, id_so4_5a, id_so4_6a + integer :: id_nh4_1a, id_nh4_2a, id_nh4_3a, id_nh4_4a, id_nh4_5a, id_nh4_6a + integer :: l,n + integer :: i,k + + logical :: mode7 + + mode7 = ntot_amode == 7 + + conc_obj => cldaero_allocate() + + do k = 1,pver + do i = 1,ncol + if( cldfrc(i,k) >0._r8) then + conc_obj%xlwc(i,k) = lwc(i,k) *cfact(i,k) ! cloud water L(water)/L(air) + conc_obj%xlwc(i,k) = conc_obj%xlwc(i,k) / cldfrc(i,k) ! liquid water in the cloudy fraction of cell + else + conc_obj%xlwc(i,k) = 0._r8 + endif + enddo + enddo + + conc_obj%no3c(:,:) = 0._r8 + + if (mode7) then +#if ( defined MODAL_AERO_7MODE ) +!put ifdef here so ifort will compile + id_so4_1a = lptr_so4_cw_amode(1) - loffset + id_so4_2a = lptr_so4_cw_amode(2) - loffset + id_so4_3a = lptr_so4_cw_amode(4) - loffset + id_so4_4a = lptr_so4_cw_amode(5) - loffset + id_so4_5a = lptr_so4_cw_amode(6) - loffset + id_so4_6a = lptr_so4_cw_amode(7) - loffset + + id_nh4_1a = lptr_nh4_cw_amode(1) - loffset + id_nh4_2a = lptr_nh4_cw_amode(2) - loffset + id_nh4_3a = lptr_nh4_cw_amode(4) - loffset + id_nh4_4a = lptr_nh4_cw_amode(5) - loffset + id_nh4_5a = lptr_nh4_cw_amode(6) - loffset + id_nh4_6a = lptr_nh4_cw_amode(7) - loffset +#endif + conc_obj%so4c(:ncol,:) & + = qcw(:ncol,:,id_so4_1a) & + + qcw(:ncol,:,id_so4_2a) & + + qcw(:ncol,:,id_so4_3a) & + + qcw(:ncol,:,id_so4_4a) & + + qcw(:ncol,:,id_so4_5a) & + + qcw(:ncol,:,id_so4_6a) + + conc_obj%nh4c(:ncol,:) & + = qcw(:ncol,:,id_nh4_1a) & + + qcw(:ncol,:,id_nh4_2a) & + + qcw(:ncol,:,id_nh4_3a) & + + qcw(:ncol,:,id_nh4_4a) & + + qcw(:ncol,:,id_nh4_5a) & + + qcw(:ncol,:,id_nh4_6a) + else + id_so4_1a = lptr_so4_cw_amode(1) - loffset + id_so4_2a = lptr_so4_cw_amode(2) - loffset + id_so4_3a = lptr_so4_cw_amode(3) - loffset + conc_obj%so4c(:ncol,:) & + = qcw(:,:,id_so4_1a) & + + qcw(:,:,id_so4_2a) & + + qcw(:,:,id_so4_3a) + + ! for 3-mode, so4 is assumed to be nh4hso4 + ! the partial neutralization of so4 is handled by using a + ! -1 charge (instead of -2) in the electro-neutrality equation + conc_obj%nh4c(:ncol,:) = 0._r8 + + ! with 3-mode, assume so4 is nh4hso4, and so half-neutralized + conc_obj%so4_fact = 1._r8 + + endif + + end function sox_cldaero_create_obj + +!---------------------------------------------------------------------------------- +! Update the mixing ratios +!---------------------------------------------------------------------------------- + subroutine sox_cldaero_update( state, & + pbuf, ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, & + delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, & + aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d) + + use physics_types, only: physics_state + + ! args + + type(physics_state), intent(in) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol + integer, intent(in) :: lchnk ! chunk id + integer, intent(in) :: loffset + + real(r8), intent(in) :: dtime ! time step (sec) + + real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu ) + real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: press(:,:) + real(r8), intent(in) :: tfld(:,:) + + real(r8), intent(in) :: cldnum(:,:) + real(r8), intent(in) :: cldfrc(:,:) + real(r8), intent(in) :: cfact(:,:) + real(r8), intent(in) :: xlwc(:,:) + + real(r8), intent(in) :: delso4_hprxn(:,:) + real(r8), intent(in) :: xh2so4(:,:) + real(r8), intent(in) :: xso4(:,:) + real(r8), intent(in) :: xso4_init(:,:) + real(r8), intent(in) :: nh3g(:,:) + real(r8), intent(in) :: hno3g(:,:) + real(r8), intent(in) :: xnh3(:,:) + real(r8), intent(in) :: xhno3(:,:) + real(r8), intent(in) :: xnh4c(:,:) + real(r8), intent(in) :: xmsa(:,:) + real(r8), intent(in) :: xso2(:,:) + real(r8), intent(in) :: xh2o2(:,:) + real(r8), intent(in) :: xno3c(:,:) + + real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr) + real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr ) + + real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry + real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) + real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2) + + + ! local vars ... + + real(r8) :: dqdt_aqso4(ncol,pver,gas_pcnst), & + dqdt_aqh2so4(ncol,pver,gas_pcnst), & + dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), & + sflx(1:ncol) + + real(r8) :: faqgain_msa(ntot_amode), faqgain_so4(ntot_amode), qnum_c(ntot_amode) + + real(r8) :: delso4_o3rxn, & + dso4dt_aqrxn, dso4dt_hprxn, & + dso4dt_gasuptk, dmsadt_gasuptk, & + dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, & + dqdt_aq, dqdt_wr, dqdt + + real(r8) :: fwetrem, sumf, uptkrate + real(r8) :: delnh3, delnh4 + + integer :: l, n, m + integer :: ntot_msa_c + + integer :: i,k + real(r8) :: xl + + ! make sure dqdt is zero initially, for budgets + dqdt_aqso4(:,:,:) = 0.0_r8 + dqdt_aqh2so4(:,:,:) = 0.0_r8 + dqdt_aqhprxn(:,:) = 0.0_r8 + dqdt_aqo3rxn(:,:) = 0.0_r8 + + ! Avoid double counting in-cloud sulfur oxidation when running with + ! GEOS-Chem. If running with GEOS-Chem then sulfur oxidation + ! is performed internally to GEOS-Chem. Here, we just return to the + ! parent routine and thus we do not apply tendencies calculated by MAM. + if ( cam_chempkg_is('geoschem_mam4') ) return + + lev_loop: do k = 1,pver + col_loop: do i = 1,ncol + cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then + xl = xlwc(i,k) ! / cldfrc(i,k) + + IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED + + delso4_o3rxn = xso4(i,k) - xso4_init(i,k) + + if (id_nh3>0) then + delnh3 = nh3g(i,k) - xnh3(i,k) + delnh4 = - delnh3 + endif + + !------------------------------------------------------------------------- + ! compute factors for partitioning aerosol mass gains among modes + ! the factors are proportional to the activated particle MR for each + ! mode, which is the MR of cloud drops "associated with" the mode + ! thus we are assuming the cloud drop size is independent of the + ! associated aerosol mode properties (i.e., drops associated with + ! Aitken and coarse sea-salt particles are same size) + ! + ! qnum_c(n) = activated particle number MR for mode n (these are just + ! used for partitioning among modes, so don't need to divide by cldfrc) + + do n = 1, ntot_amode + qnum_c(n) = 0.0_r8 + l = numptrcw_amode(n) - loffset + if (l > 0) qnum_c(n) = max( 0.0_r8, qcw(i,k,l) ) + end do + + ! force qnum_c(n) to be positive for n=modeptr_accum or n=1 + n = modeptr_accum + if (n <= 0) n = 1 + qnum_c(n) = max( 1.0e-10_r8, qnum_c(n) ) + + ! faqgain_so4(n) = fraction of total so4_c gain going to mode n + ! these are proportional to the activated particle MR for each mode + sumf = 0.0_r8 + do n = 1, ntot_amode + faqgain_so4(n) = 0.0_r8 + if (lptr_so4_cw_amode(n) > 0) then + faqgain_so4(n) = qnum_c(n) + sumf = sumf + faqgain_so4(n) + end if + end do + + if (sumf > 0.0_r8) then + do n = 1, ntot_amode + faqgain_so4(n) = faqgain_so4(n) / sumf + end do + end if + ! at this point (sumf <= 0.0) only when all the faqgain_so4 are zero + + ! faqgain_msa(n) = fraction of total msa_c gain going to mode n + ntot_msa_c = 0 + sumf = 0.0_r8 + do n = 1, ntot_amode + faqgain_msa(n) = 0.0_r8 + if (lptr_msa_cw_amode(n) > 0) then + faqgain_msa(n) = qnum_c(n) + ntot_msa_c = ntot_msa_c + 1 + end if + sumf = sumf + faqgain_msa(n) + end do + + if (sumf > 0.0_r8) then + do n = 1, ntot_amode + faqgain_msa(n) = faqgain_msa(n) / sumf + end do + end if + ! at this point (sumf <= 0.0) only when all the faqgain_msa are zero + + uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) ) + ! average uptake rate over dtime + uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime + + ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s) + ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s) + dso4dt_gasuptk = xh2so4(i,k) * uptkrate + if (id_msa > 0) then + dmsadt_gasuptk = xmsa(i,k) * uptkrate + else + dmsadt_gasuptk = 0.0_r8 + end if + + ! if no modes have msa aerosol, then "rename" scavenged msa gas to so4 + dmsadt_gasuptk_toso4 = 0.0_r8 + dmsadt_gasuptk_tomsa = dmsadt_gasuptk + if (ntot_msa_c == 0) then + dmsadt_gasuptk_tomsa = 0.0_r8 + dmsadt_gasuptk_toso4 = dmsadt_gasuptk + end if + + !----------------------------------------------------------------------- + ! now compute TMR tendencies + ! this includes the above aqueous so2 chemistry AND + ! the uptake of highly soluble aerosol precursor gases (h2so4, msa, ...) + ! AND the wetremoval of dissolved, unreacted so2 and h2o2 + + dso4dt_aqrxn = (delso4_o3rxn + delso4_hprxn(i,k)) / dtime + dso4dt_hprxn = delso4_hprxn(i,k) / dtime + + ! fwetrem = fraction of in-cloud-water material that is wet removed + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't have so4 & msa wet removal here + + ! compute TMR tendencies for so4 and msa aerosol-in-cloud-water + do n = 1, ntot_amode + l = lptr_so4_cw_amode(n) - loffset + if (l > 0) then + dqdt_aqso4(i,k,l) = faqgain_so4(n)*dso4dt_aqrxn*cldfrc(i,k) + dqdt_aqh2so4(i,k,l) = faqgain_so4(n)* & + (dso4dt_gasuptk + dmsadt_gasuptk_toso4)*cldfrc(i,k) + dqdt_aq = dqdt_aqso4(i,k,l) + dqdt_aqh2so4(i,k,l) + dqdt_wr = -fwetrem*dqdt_aq + dqdt= dqdt_aq + dqdt_wr + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + end if + + l = lptr_msa_cw_amode(n) - loffset + if (l > 0) then + dqdt_aq = faqgain_msa(n)*dmsadt_gasuptk_tomsa*cldfrc(i,k) + dqdt_wr = -fwetrem*dqdt_aq + dqdt = dqdt_aq + dqdt_wr + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + end if + + l = lptr_nh4_cw_amode(n) - loffset + if (l > 0) then + if (delnh4 > 0.0_r8) then + dqdt_aq = faqgain_so4(n)*delnh4/dtime*cldfrc(i,k) + dqdt = dqdt_aq + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + else + dqdt = (qcw(i,k,l)/max(xnh4c(i,k),1.0e-35_r8)) & + *delnh4/dtime*cldfrc(i,k) + qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime + endif + end if + end do + + ! For gas species, tendency includes + ! reactive uptake to cloud water that essentially transforms the gas to + ! a different species. Wet removal associated with this is applied + ! to the "new" species (e.g., so4_c) rather than to the gas. + ! wet removal of the unreacted gas that is dissolved in cloud water. + ! Need to multiply both these parts by cldfrc + + ! h2so4 (g) & msa (g) + qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k) + if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k) + + ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include so2 wet removal here + + dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime + + ! h2o2 -- the first order loss rate for h2o2 is frh2o2_c*clwlrat(i,k) + ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frh2o2_c*clwlrat(i,k)))) ) + fwetrem = 0.0_r8 ! don't include h2o2 wet removal here + + dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k) + dqdt_aq = -dso4dt_hprxn*cldfrc(i,k) + dqdt = dqdt_aq + dqdt_wr + qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime + + ! NH3 + if (id_nh3>0) then + dqdt_aq = delnh3/dtime*cldfrc(i,k) + dqdt = dqdt_aq + qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime + endif + + ! for SO4 from H2O2/O3 budgets + dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k) + dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k) + + ENDIF !! WHEN CLOUD IS PRESENTED + endif cloud + enddo col_loop + enddo lev_loop + + !============================================================== + ! ... Update the mixing ratios + !============================================================== + do k = 1,pver + + do n = 1, ntot_amode + + l = lptr_so4_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + l = lptr_msa_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + l = lptr_nh4_cw_amode(n) - loffset + if (l > 0) then + qcw(:,k,l) = MAX(qcw(:,k,l), small_value ) + end if + + end do + + qin(:,k,id_so2) = MAX( qin(:,k,id_so2), small_value ) + + if ( id_nh3 > 0 ) then + qin(:,k,id_nh3) = MAX( qin(:,k,id_nh3), small_value ) + endif + + end do + + ! diagnostics + + do n = 1, ntot_amode + m = lptr_so4_cw_amode(n) + l = m - loffset + aqso4(:,n)=0._r8 + aqh2so4(:,n)=0._r8 + if (l > 0) then + do k=1,pver + do i=1,ncol + aqso4(i,n)=aqso4(i,n)+dqdt_aqso4(i,k,l)*adv_mass(l)/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + + do k=1,pver + do i=1,ncol + aqh2so4(i,n)=aqh2so4(i,n)+dqdt_aqh2so4(i,k,l)*adv_mass(l)/mbar(i,k) & + *pdel(i,k)/gravit ! kg/m2/s + enddo + enddo + endif + end do + + aqso4_h2o2(:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2(i)=aqso4_h2o2(i)+dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_h2o2_3d)) then + aqso4_h2o2_3d(:,:) = 0._r8 + do k=1,pver + do i=1,ncol + aqso4_h2o2_3d(i,k)=dqdt_aqhprxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + aqso4_o3(:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3(i)=aqso4_o3(i)+dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + + if (present(aqso4_o3_3d)) then + aqso4_o3_3d(:,:)=0._r8 + do k=1,pver + do i=1,ncol + aqso4_o3_3d(i,k)=dqdt_aqo3rxn(i,k)*specmw_so4_amode/mbar(i,k) & + *pdel(i,k)/gravit ! kg SO4 /m2/s + enddo + enddo + end if + + end subroutine sox_cldaero_update + + !---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine sox_cldaero_destroy_obj( conc_obj ) + type(cldaero_conc_t), pointer :: conc_obj + + call cldaero_deallocate( conc_obj ) + + end subroutine sox_cldaero_destroy_obj + +end module mam_clouds diff --git a/src/physics/cam/carma_intr.F90 b/src/physics/cam/carma_intr.F90 index 2498d493fd..b2f8872336 100644 --- a/src/physics/cam/carma_intr.F90 +++ b/src/physics/cam/carma_intr.F90 @@ -38,8 +38,6 @@ module carma_intr public carma_timestep_init ! initialize timestep dependent variables public carma_timestep_tend ! interface to tendency computation public carma_accumulate_stats ! collect stats from all MPI tasks - public carma_checkstate_global ! check if the coremass exceeding the total, globally - public carma_calculate_globalmassfactor ! determine mass factors needed for carma_checkstate_global ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function @@ -163,27 +161,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli end subroutine carma_timestep_tend - subroutine carma_calculate_globalmassfactor(state) - use ppgrid, only: begchunk, endchunk - - type(physics_state), intent(in), dimension(begchunk:endchunk) :: state !! All the chunks in this task. - return - end subroutine carma_calculate_globalmassfactor - - - subroutine carma_checkstate_global(state, ptend, dt) - use physconst, only: gravit - - type(physics_state), intent(in) :: state !! Physics state variables - before CARMA - type(physics_ptend), intent(inout) :: ptend !! indivdual parameterization tendencies - real(r8), intent(in) :: dt !! timestep (s) - - call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update - - return - end subroutine carma_checkstate_global - - subroutine carma_init_cnst(name, latvals, lonvals, mask, q) implicit none diff --git a/src/physics/carma/base b/src/physics/carma/base index 4dbf023451..67418505b4 160000 --- a/src/physics/carma/base +++ b/src/physics/carma/base @@ -1 +1 @@ -Subproject commit 4dbf023451fdf6e4add71d791b0ab9664e24246b +Subproject commit 67418505b48787bd305a50ffb581f98f0b466cba diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 21efac93a3..47af8ff6fc 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -198,12 +198,6 @@ module carma_intr real(kind=f) :: step_nsubstep = 0._f real(kind=f) :: step_nretry = 0._f - ! Scaling factors used to conserve the mass of the condensing gases in groups - ! with core masses. This is for use after advection where errors in - ! tracer/tracer relationships can introduce negative values for the condensing - ! elements. - real (r8) :: carma_massscalefactor(NGROUP, NBIN) - contains @@ -1494,7 +1488,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') spdiags(icol, :, SPDIAGS_NSTEP) = zsubsteps(:) - spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + where (zsubsteps/=0.0_r8) + spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + end where end if end do diff --git a/src/physics/carma/cam/carma_precision_mod.F90 b/src/physics/carma/cam/carma_precision_mod.F90 index ae22471312..db76f798c6 100644 --- a/src/physics/carma/cam/carma_precision_mod.F90 +++ b/src/physics/carma/cam/carma_precision_mod.F90 @@ -35,4 +35,4 @@ module carma_precision_mod !! Define smallest possible number such that ONE + ALMOST_ZERO > ONE real(kind=f), parameter :: ALMOST_ZERO = epsilon( ONE ) real(kind=f), parameter :: ALMOST_ONE = ONE - ALMOST_ZERO -end module carma_precision_mod +end module diff --git a/test/chemistry/CMakeLists.txt b/test/chemistry/CMakeLists.txt new file mode 100644 index 0000000000..dbe9ee86a9 --- /dev/null +++ b/test/chemistry/CMakeLists.txt @@ -0,0 +1,21 @@ +cmake_minimum_required(VERSION 3.6) + +project( + cam_chemistry_tests + VERSION 0.1.0 + LANGUAGES Fortran +) + +option(CAMCHEM_ENABLE_MEMCHECK "Enable memory checking with valgrind" ON) +option(CAMCHEM_ENABLE_MPI "Build with MPI support" OFF) +option(CAMCHEM_ENABLE_OPENMP "Build with OpenMP support" OFF) + +include(cmake/dependencies.cmake) + +# Copy test data +add_custom_target(copy_test_data ALL ${CMAKE_COMMAND} -E copy_directory + ${CMAKE_CURRENT_SOURCE_DIR}/data ${CMAKE_BINARY_DIR}/test/chemistry/data) + +enable_testing() + +add_subdirectory(cloud_aqueous_chemistry) \ No newline at end of file diff --git a/test/chemistry/Dockerfile b/test/chemistry/Dockerfile new file mode 100644 index 0000000000..bd7e795ce9 --- /dev/null +++ b/test/chemistry/Dockerfile @@ -0,0 +1,31 @@ +FROM fedora:41 + +RUN dnf -y update \ + && dnf -y install \ + cmake \ + gcc \ + gcc-c++ \ + gcc-fortran \ + gdb \ + git \ + lapack-devel \ + lcov \ + m4 \ + make \ + netcdf-fortran-devel \ + python3 \ + python3-pip \ + valgrind \ + && dnf clean all + +COPY . /cam + +RUN cd /cam/test/chemistry \ + && mkdir build \ + && cd build \ + && cmake \ + -D CMAKE_BUILD_TYPE=DEBUG \ + .. \ + && make + +WORKDIR /cam/test/chemistry/build diff --git a/test/chemistry/README.md b/test/chemistry/README.md new file mode 100644 index 0000000000..f28985913b --- /dev/null +++ b/test/chemistry/README.md @@ -0,0 +1,22 @@ +Chemistry Tests +=============== + +Tests in this folder are used to support the porting of CAM-Chem functionality to CAM-SIMA. + +To build and run the test suite, from this folder run: + +``` +mkdir build +cd build +cmake .. +make +make test +``` + +To run the tests in a Docker container, from the `CAM/test/chemistry` folder run: + +``` +docker build -t cam-test ../../ -f Dockerfile +docker run -it cam-test bash +make test +``` \ No newline at end of file diff --git a/test/chemistry/cloud_aqueous_chemistry/CMakeLists.txt b/test/chemistry/cloud_aqueous_chemistry/CMakeLists.txt new file mode 100644 index 0000000000..dcc7f56f56 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/CMakeLists.txt @@ -0,0 +1,83 @@ +################################################################################ +# Test utilities + +include(${CMAKE_SOURCE_DIR}/cmake/test_util.cmake) + +################################################################################ +# New cloud aqueous chemistry code tests + +create_standard_test( + NAME cloud_aqueous_chemistry_MAM + SOURCES + test_cloud_aqueous_chemistry_MAM.F90 + cloud_chemistry_dependencies_MAM.F90 + ../file_io.F90 + ../../../src/chemistry/aerosol/cloud_aqueous_chemistry.F90 + ../../../src/chemistry/aerosol/cloud_utilities.F90 + ../../../src/chemistry/bulk_aero/bam_clouds.F90 + ../../../src/chemistry/modal_aero/mam_clouds.F90 + ../../../src/chemistry/carma_aero/carma_clouds.F90 + ../../../src/chemistry/aerosol/mo_setsox.F90 + ../../../src/chemistry/aerosol/cldaero_mod.F90 + ../../../src/chemistry/modal_aero/sox_cldaero_mod.F90 + CPP_FLAGS + -DUSE_MAM + WORKING_DIRECTORY + ${CMAKE_BINARY_DIR}/cloud_aqueous_chemistry) + +create_standard_test( + NAME cloud_aqueous_chemistry_BAM + SOURCES + test_cloud_aqueous_chemistry_BAM.F90 + cloud_chemistry_dependencies_BAM.F90 + ../file_io.F90 + ../../../src/chemistry/aerosol/cloud_aqueous_chemistry.F90 + ../../../src/chemistry/aerosol/cloud_utilities.F90 + ../../../src/chemistry/bulk_aero/bam_clouds.F90 + ../../../src/chemistry/modal_aero/mam_clouds.F90 + ../../../src/chemistry/carma_aero/carma_clouds.F90 + ../../../src/chemistry/aerosol/mo_setsox.F90 + ../../../src/chemistry/aerosol/cldaero_mod.F90 + ../../../src/chemistry/bulk_aero/sox_cldaero_mod.F90 + CPP_FLAGS + -DUSE_BAM + WORKING_DIRECTORY + ${CMAKE_BINARY_DIR}/cloud_aqueous_chemistry) + +create_standard_test( + NAME cloud_aqueous_chemistry_CARMA + SOURCES + test_cloud_aqueous_chemistry_CARMA.F90 + cloud_chemistry_dependencies_CARMA.F90 + ../file_io.F90 + ../../../src/chemistry/aerosol/cloud_aqueous_chemistry.F90 + ../../../src/chemistry/aerosol/cloud_utilities.F90 + ../../../src/chemistry/bulk_aero/bam_clouds.F90 + ../../../src/chemistry/modal_aero/mam_clouds.F90 + ../../../src/chemistry/carma_aero/carma_clouds.F90 + ../../../src/chemistry/aerosol/mo_setsox.F90 + ../../../src/chemistry/aerosol/cldaero_mod.F90 + ../../../src/chemistry/carma_aero/sox_cldaero_mod.F90 + CPP_FLAGS + -DUSE_CARMA + WORKING_DIRECTORY + ${CMAKE_BINARY_DIR}/cloud_aqueous_chemistry) + +create_standard_test( + NAME cloud_aqueous_chemistry_full + SOURCES + test_cloud_aqueous_chemistry_full.F90 + cloud_chemistry_dependencies_full.F90 + ../file_io.F90 + ../../../src/chemistry/aerosol/cloud_aqueous_chemistry.F90 + ../../../src/chemistry/aerosol/cloud_utilities.F90 + ../../../src/chemistry/bulk_aero/bam_clouds.F90 + ../../../src/chemistry/modal_aero/mam_clouds.F90 + ../../../src/chemistry/carma_aero/carma_clouds.F90 + ../../../src/chemistry/aerosol/mo_setsox.F90 + ../../../src/chemistry/aerosol/cldaero_mod.F90 + ../../../src/chemistry/modal_aero/sox_cldaero_mod.F90 + CPP_FLAGS + -DUSE_MAM + WORKING_DIRECTORY + ${CMAKE_BINARY_DIR}/cloud_aqueous_chemistry) diff --git a/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_BAM.F90 b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_BAM.F90 new file mode 100644 index 0000000000..148c7b74e5 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_BAM.F90 @@ -0,0 +1,258 @@ +! Mocked dependencies of cloud aqueous chemistry module +module chemistry_test_data + implicit none + public + logical :: do_debug_logging = .false. + integer :: debug_column = -1 + integer :: debug_level = -1 +end module chemistry_test_data + +module shr_kind_mod + implicit none + public :: shr_kind_r8 + integer, parameter :: shr_kind_r8 = kind(0.0d0) +end module shr_kind_mod + +module spmd_utils + implicit none + public :: masterproc + logical :: masterproc = .true. +end module spmd_utils + +module cam_logfile + implicit none + public :: iulog + integer, parameter :: iulog = 6 +end module cam_logfile + +module physics_buffer + implicit none + public :: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + integer, parameter :: dtype_r8 = 1 + integer, parameter :: pbuf_get_index = 1 + integer, parameter :: pbuf_add_field = 1 + type :: physics_buffer_desc + end type physics_buffer_desc +end module physics_buffer + +module physics_types + implicit none + public :: physics_state + type :: physics_state + end type physics_state +end module physics_types + +module mo_chem_utls + implicit none + public :: get_spc_ndx, get_inv_ndx +contains + integer function get_spc_ndx(spc_name) + character(len=*), intent(in) :: spc_name + select case (trim(adjustl(spc_name))) + case ('O3') + get_spc_ndx = 1 + case ('SO2') + get_spc_ndx = 83 + case ('NH3') + get_spc_ndx = 86 + case ('HNO3') + get_spc_ndx = 8 + case ('H2O2') + get_spc_ndx = 14 + case ('HO2') + get_spc_ndx = 13 + case ('SO4') + get_spc_ndx = 85 + case default + get_spc_ndx = -1 + end select + end function get_spc_ndx + integer function get_inv_ndx(inv_name) + character(len=*), intent(in) :: inv_name + select case (trim(adjustl(inv_name))) + case default + get_inv_ndx = -1 + end select + end function get_inv_ndx +end module mo_chem_utls + +module carma_flags_mod + implicit none + public :: carma_do_cloudborne + logical, parameter :: carma_do_cloudborne = .false. +end module carma_flags_mod + +module phys_control + implicit none + public :: phys_getopts, cam_chempkg_is +contains + subroutine phys_getopts(prog_modal_aero_out, history_aerosol_out) + logical, optional, intent(out) :: prog_modal_aero_out + logical, optional, intent(out) :: history_aerosol_out + if (present(prog_modal_aero_out)) then + prog_modal_aero_out = .false. + end if + if (present(history_aerosol_out)) then + history_aerosol_out = .false. + end if + end subroutine phys_getopts + logical function cam_chempkg_is(pkg) + character(len=*), intent(in) :: pkg + cam_chempkg_is = .false. + end function cam_chempkg_is +end module phys_control + +module ppgrid + implicit none + public :: pcols, pver + integer, parameter :: pcols = 16 + integer, parameter :: pver = 26 +end module ppgrid + +module chem_mods + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: gas_pcnst, nfs, adv_mass + integer, parameter :: gas_pcnst = 103 + integer, parameter :: nfs = 4 + real(kind=r8), parameter :: adv_mass(*) = (/ & + 47.998199999999997, 15.999400000000000, 15.999400000000000, 44.012880000000003, & + 30.006139999999998, 46.005540000000003, 62.004939999999998, 63.012340000000002, & + 79.011740000000003, 108.01048000000000, 2.0148000000000001, 17.006799999999998, & + 33.006200000000000, 34.013599999999997, 16.040600000000001, 28.010400000000001, & + 47.031999999999996, 48.039400000000001, 30.025200000000002, 32.039999999999999, & + 46.065800000000003, 28.051600000000001, 61.057800000000000, 77.057199999999995, & + 60.050400000000003, 60.050400000000003, 30.066400000000002, 61.057800000000000, & + 62.065199999999997, 44.051000000000002, 75.042400000000001, 76.049800000000005, & + 42.077399999999997, 44.092199999999998, 75.083600000000004, 76.090999999999994, & + 91.082999999999998, 92.090400000000002, 58.076799999999999, 89.068200000000004, & + 90.075599999999994, 56.103200000000001, 105.10880000000000, 72.102599999999995, & + 103.09399999999999, 104.10140000000000, 72.143799999999999, 103.13520000000000, & + 104.14260000000000, 68.114199999999997, 117.11980000000000, 118.12720000000000, & + 70.087800000000001, 70.087800000000001, 119.09340000000000, 120.10080000000001, & + 101.07920000000000, 100.11300000000000, 74.076200000000000, 72.061400000000006, & + 149.11859999999999, 150.12600000000000, 136.22839999999999, 185.23400000000001, & + 186.24140000000000, 92.136200000000002, 108.13560000000000, 173.14060000000001, & + 174.14800000000000, 190.14740000000000, 98.098200000000006, 58.035600000000002, & + 121.04794000000000, 119.07434000000001, 147.08474000000001, 162.11794000000000, & + 147.12594000000001, 12.010999999999999, 12.010999999999999, 12.010999999999999, & + 12.010999999999999, 144.13200000000001, 64.064800000000005, 62.132399999999997, & + 96.063599999999994, 17.028939999999999, 18.036339999999999, 80.041280000000000, & + 58.442467999999998, 58.442467999999998, 58.442467999999998, 58.442467999999998, & + 135.06403900000001, 135.06403900000001, 135.06403900000001, 135.06403900000001, & + 222.00000000000000, 207.19999999999999, 27.025140000000000, 41.050939999999997, & + 26.036799999999999, 46.024600000000000, 63.031399999999998 /) +end module chem_mods + +module physconst + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: mwdry, gravit + real(kind=shr_kind_r8), parameter :: mwdry = 28.966000000000001_shr_kind_r8 + real(kind=shr_kind_r8), parameter :: gravit = 9.8061600000000002_shr_kind_r8 +end module physconst + +module mo_constants + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: pi + real(kind=shr_kind_r8), parameter :: pi = 3.1415926535897931_shr_kind_r8 +end module mo_constants + +module cam_abortutils + implicit none + public :: endrun +contains + subroutine endrun(msg) + character(len=*), intent(in) :: msg + write(*,*) msg + stop 3 + end subroutine endrun +end module cam_abortutils + +module rad_constituents + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx +contains + subroutine rad_cnst_get_info(list_idx, nbins) + integer, intent(in) :: list_idx + integer, optional, intent(out) :: nbins + if(present(nbins)) then + nbins = 0 + end if + end subroutine rad_cnst_get_info + subroutine rad_cnst_get_info_by_bin(list_idx, bin_idx, nspec, bin_name) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, optional, intent(out) :: nspec + character(len=*), optional, intent(out) :: bin_name + if(present(bin_name)) then + bin_name = 'something' + end if + if(present(nspec)) then + nspec = 0 + end if + end subroutine rad_cnst_get_info_by_bin + subroutine rad_cnst_get_bin_props_by_idx(list_idx, bin_idx, spec_idx, spectype) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + character(len=*), optional, intent(out) :: spectype + if(present(spectype)) then + spectype = 'sulfate' + end if + end subroutine rad_cnst_get_bin_props_by_idx +end module rad_constituents + +module aerosol_properties_mod + implicit none + public :: aero_name_len + integer, parameter :: aero_name_len = 32 +end module aerosol_properties_mod + +module modal_aero_data + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode, & + numptrcw_amode, lptr_nh4_cw_amode, cnst_name_cw, specmw_so4_amode + integer, parameter :: ntot_amode = 4 + integer, parameter :: modeptr_accum = 1 + integer, parameter :: lptr_so4_cw_amode(*) = (/ 28, 29, 30, -999888777 /) + integer, parameter :: lptr_msa_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + integer, parameter :: numptrcw_amode(*) = (/ 21, 22, 23, 24 /) + integer, parameter :: lptr_nh4_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + character(len=6), parameter :: cnst_name_cw(*) = (/ & + ' bc_c1', ' bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'num_c1', & + 'num_c2', 'num_c3', 'num_c4', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', & + 'soa_c2' /) + real(kind=r8), parameter :: specmw_so4_amode = 115.10733999999999_r8 +end module modal_aero_data + +module carma_intr + implicit none + public :: carma_get_group_by_name, carma_get_dry_radius +contains + subroutine carma_get_group_by_name(short_name, igroup, rc) + character(len=*), intent(in) :: short_name + integer, intent(out) :: igroup + integer, intent(out) :: rc + igroup = 1 + rc = 0 + end subroutine carma_get_group_by_name + subroutine carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + use physics_types, only: physics_state + use shr_kind_mod, only: r8 => shr_kind_r8 + type(physics_state), intent(in) :: state + integer, intent(in) :: igroup + integer, intent(in) :: ibin + real(kind=r8), intent(out) :: dryr(:,:) + real(kind=r8), intent(out) :: rho(:,:) + integer, intent(out) :: rc + dryr(:,:) = 0.0_r8 ! m + rho(:,:) = 0.0_r8 ! kg m-3 + rc = 0 + end subroutine carma_get_dry_radius +end module carma_intr + + diff --git a/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_CARMA.F90 b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_CARMA.F90 new file mode 100644 index 0000000000..1cb9bf5c52 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_CARMA.F90 @@ -0,0 +1,301 @@ +! Mocked dependencies of cloud aqueous chemistry module +module chemistry_test_data + implicit none + public + logical :: do_debug_logging = .false. + integer :: debug_column = -1 + integer :: debug_level = -1 +end module chemistry_test_data + +module shr_kind_mod + implicit none + public :: shr_kind_r8 + integer, parameter :: shr_kind_r8 = kind(0.0d0) +end module shr_kind_mod + +module spmd_utils + implicit none + public :: masterproc + logical :: masterproc = .true. +end module spmd_utils + +module cam_logfile + implicit none + public :: iulog + integer, parameter :: iulog = 6 +end module cam_logfile + +module physics_buffer + implicit none + public :: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + integer, parameter :: dtype_r8 = 1 + integer, parameter :: pbuf_get_index = 1 + integer, parameter :: pbuf_add_field = 1 + type :: physics_buffer_desc + end type physics_buffer_desc +end module physics_buffer + +module physics_types + implicit none + public :: physics_state + type :: physics_state + end type physics_state +end module physics_types + +module mo_chem_utls + implicit none + public :: get_spc_ndx, get_inv_ndx +contains + integer function get_spc_ndx(spc_name) + character(len=*), intent(in) :: spc_name + select case (trim(adjustl(spc_name))) + case ('O3') + get_spc_ndx = 122 + case ('SO2') + get_spc_ndx = 137 + case ('NH3') + get_spc_ndx = 112 + case ('HNO3') + get_spc_ndx = 84 + case ('H2O2') + get_spc_ndx = 74 + case ('HO2') + get_spc_ndx = 176 + case ('H2SO4') + get_spc_ndx = 75 + case default + get_spc_ndx = -1 + end select + end function get_spc_ndx + integer function get_inv_ndx(inv_name) + character(len=*), intent(in) :: inv_name + select case (trim(adjustl(inv_name))) + case default + get_inv_ndx = -1 + end select + end function get_inv_ndx +end module mo_chem_utls + +module carma_flags_mod + implicit none + public :: carma_do_cloudborne + logical, parameter :: carma_do_cloudborne = .true. +end module carma_flags_mod + +module phys_control + implicit none + public :: phys_getopts, cam_chempkg_is +contains + subroutine phys_getopts(prog_modal_aero_out, history_aerosol_out) + logical, optional, intent(out) :: prog_modal_aero_out + logical, optional, intent(out) :: history_aerosol_out + if (present(prog_modal_aero_out)) then + prog_modal_aero_out = .false. + end if + if (present(history_aerosol_out)) then + history_aerosol_out = .false. + end if + end subroutine phys_getopts + logical function cam_chempkg_is(pkg) + character(len=*), intent(in) :: pkg + cam_chempkg_is = .false. + end function cam_chempkg_is +end module phys_control + +module ppgrid + implicit none + public :: pcols, pver + integer, parameter :: pcols = 16 + integer, parameter :: pver = 32 +end module ppgrid + +module chem_mods + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: gas_pcnst, nfs, adv_mass + integer, parameter :: gas_pcnst = 202 + integer, parameter :: nfs = 3 + real(kind=r8), parameter :: adv_mass(*) = (/ & + 133.14134000000001_r8, 104.14260000000000_r8, 28.010400000000001_r8, 204.34260000000000_r8, & + 78.110399999999998_r8, 160.12219999999999_r8, 126.10860000000000_r8, 98.098200000000006_r8, & + 84.072400000000002_r8, 98.098200000000006_r8, 98.098200000000006_r8, 112.12400000000000_r8, & + 72.143799999999999_r8, 56.103200000000001_r8, 79.903999999999996_r8, 115.35670000000000_r8, & + 95.903400000000005_r8, 141.90894000000000_r8, 99.716849999999994_r8, 106.12080000000000_r8, & + 124.13500000000001_r8, 26.036799999999999_r8, 28.051600000000001_r8, 46.065800000000003_r8, & + 62.065199999999997_r8, 30.066400000000002_r8, 42.077399999999997_r8, 76.090999999999994_r8, & + 44.092199999999998_r8, 110.10920000000000_r8, 153.82180000000000_r8, 165.36450600000001_r8, & + 148.91021000000001_r8, 137.36750300000000_r8, 187.37531000000001_r8, 170.92101299999999_r8, & + 154.46671599999999_r8, 120.91320600000000_r8, 173.83380000000000_r8, 30.025200000000002_r8, & + 94.937200000000004_r8, 133.40230000000000_r8, 44.051000000000002_r8, 50.485900000000001_r8, & + 41.050939999999997_r8, 58.076799999999999_r8, 72.061400000000006_r8, 60.050400000000003_r8, & + 76.049800000000005_r8, 32.039999999999999_r8, 48.039400000000001_r8, 16.040600000000001_r8, & + 252.73040000000000_r8, 35.452700000000000_r8, 70.905400000000000_r8, 102.90420000000000_r8, & + 51.452100000000002_r8, 97.457639999999998_r8, 100.91685000000000_r8, 28.010400000000001_r8, & + 44.009799999999998_r8, 66.007205999999996_r8, 82.461502999999993_r8, 108.13560000000000_r8, & + 62.132399999999997_r8, 28.010400000000001_r8, 78.064599999999999_r8, 18.998403000000000_r8, & + 60.050400000000003_r8, 58.035600000000002_r8, 1.0074000000000001_r8, 2.0148000000000001_r8, & + 259.82361300000002_r8, 34.013599999999997_r8, 98.078400000000002_r8, 80.911400000000000_r8, & + 116.94800300000000_r8, 100.49370600000000_r8, 86.467905999999999_r8, 36.460099999999997_r8, & + 27.025140000000000_r8, 46.024600000000000_r8, 20.005803000000000_r8, 63.012340000000002_r8, & + 79.011740000000003_r8, 96.910799999999995_r8, 52.459499999999998_r8, 135.11493999999999_r8, & + 116.11239999999999_r8, 74.076200000000000_r8, 100.11300000000000_r8, 118.12720000000000_r8, & + 68.114199999999997_r8, 147.12594000000001_r8, 147.12594000000001_r8, 162.11794000000000_r8, & + 163.12533999999999_r8, 118.12720000000000_r8, 184.35020000000000_r8, 70.087800000000001_r8, & + 120.10080000000001_r8, 72.102599999999995_r8, 104.10140000000000_r8, 147.08474000000001_r8, & + 136.22839999999999_r8, 70.087800000000001_r8, 14.006740000000001_r8, 44.012880000000003_r8, & + 108.01048000000000_r8, 147.12594000000001_r8, 145.11114000000001_r8, 17.028939999999999_r8, & + 18.036339999999999_r8, 28.010400000000001_r8, 28.010400000000001_r8, 30.006139999999998_r8, & + 46.005540000000003_r8, 62.004939999999998_r8, 119.07434000000001_r8, 231.23954000000001_r8, & + 15.999400000000000_r8, 47.998199999999997_r8, 47.998199999999997_r8, 67.451499999999996_r8, & + 60.076400000000000_r8, 133.10014000000001_r8, 121.04794000000000_r8, 183.11774000000000_r8, & + 93.102400000000003_r8, 94.109800000000007_r8, 176.12160000000000_r8, 92.090400000000002_r8, & + 90.075599999999994_r8, 32.066000000000003_r8, 146.05641900000001_r8, 48.065399999999997_r8, & + 64.064800000000005_r8, 80.064200000000000_r8, 250.44499999999999_r8, 250.44499999999999_r8, & + 250.44499999999999_r8, 250.44499999999999_r8, 250.44499999999999_r8, 28.010400000000001_r8, & + 310.58240000000001_r8, 140.13440000000000_r8, 200.22600000000000_r8, 215.24014000000000_r8, & + 186.24140000000000_r8, 168.22720000000001_r8, 154.20140000000001_r8, 174.14800000000000_r8, & + 92.136200000000002_r8, 150.12600000000000_r8, 106.16200000000001_r8, 188.17380000000000_r8, & + 122.16140000000000_r8, 204.17320000000001_r8, 14.006740000000001_r8, 14.006740000000001_r8, & + 137.11220000000000_r8, 103.13520000000000_r8, 253.34819999999999_r8, 159.11480000000000_r8, & + 159.11480000000000_r8, 123.12760000000000_r8, 61.057800000000000_r8, 75.083600000000004_r8, & + 109.10180000000000_r8, 75.042400000000001_r8, 47.031999999999996_r8, 129.08959999999999_r8, & + 105.10880000000000_r8, 61.057800000000000_r8, 77.057199999999995_r8, 33.006200000000000_r8, & + 63.031399999999998_r8, 117.11980000000000_r8, 117.11980000000000_r8, 117.11980000000000_r8, & + 233.35579999999999_r8, 119.09340000000000_r8, 115.06380000000000_r8, 101.07920000000000_r8, & + 117.07859999999999_r8, 103.09399999999999_r8, 185.23400000000001_r8, 230.23213999999999_r8, & + 15.999400000000000_r8, 17.006799999999998_r8, 175.11420000000001_r8, 91.082999999999998_r8, & + 89.068200000000004_r8, 199.21860000000001_r8, 185.23400000000001_r8, 173.14060000000001_r8, & + 173.14060000000001_r8, 149.11859999999999_r8, 187.16640000000001_r8, 187.16640000000001_r8, & + 203.16579999999999_r8, 18.014199999999999_r8 /) +end module chem_mods + +module physconst + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: mwdry, gravit + real(kind=shr_kind_r8), parameter :: mwdry = 28.966000000000001_shr_kind_r8 + real(kind=shr_kind_r8), parameter :: gravit = 9.8061600000000002_shr_kind_r8 +end module physconst + +module mo_constants + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: pi + real(kind=shr_kind_r8), parameter :: pi = 3.1415926535897931_shr_kind_r8 +end module mo_constants + +module cam_abortutils + implicit none + public :: endrun +contains + subroutine endrun(msg) + character(len=*), intent(in) :: msg + write(*,*) msg + stop 3 + end subroutine endrun +end module cam_abortutils + +module rad_constituents + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx +contains + subroutine rad_cnst_get_info(list_idx, nbins) + integer, intent(in) :: list_idx + integer, optional, intent(out) :: nbins + if(present(nbins)) then + nbins = 40 + end if + end subroutine rad_cnst_get_info + subroutine rad_cnst_get_info_by_bin(list_idx, bin_idx, nspec, bin_name) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, optional, intent(out) :: nspec + character(len=*), optional, intent(out) :: bin_name + if(present(bin_name)) then + if (bin_idx > 20) then + write(bin_name, '(A,I2.2)') 'PRSUL', bin_idx + else + write(bin_name, '(A,I2.2)') 'MXAER', bin_idx + end if + end if + if(present(nspec)) then + if (bin_idx > 20) then + nspec = 1 + else + nspec = 10 + end if + end if + end subroutine rad_cnst_get_info_by_bin + subroutine rad_cnst_get_bin_props_by_idx(list_idx, bin_idx, spec_idx, spectype) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + character(len=*), optional, intent(out) :: spectype + if(present(spectype)) then + if (spec_idx == 1) then + spectype = 'sulfate' + else + spectype = 'something else' + end if + end if + end subroutine rad_cnst_get_bin_props_by_idx +end module rad_constituents + +module aerosol_properties_mod + implicit none + public :: aero_name_len + integer, parameter :: aero_name_len = 32 +end module aerosol_properties_mod + +module modal_aero_data + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode, & + numptrcw_amode, lptr_nh4_cw_amode, cnst_name_cw, specmw_so4_amode + integer, parameter :: ntot_amode = 4 + integer, parameter :: modeptr_accum = 1 + integer, parameter :: lptr_so4_cw_amode(*) = (/ 28, 29, 30, -999888777 /) + integer, parameter :: lptr_msa_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + integer, parameter :: numptrcw_amode(*) = (/ 21, 22, 23, 24 /) + integer, parameter :: lptr_nh4_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + character(len=6), parameter :: cnst_name_cw(*) = (/ & + ' bc_c1', ' bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'num_c1', & + 'num_c2', 'num_c3', 'num_c4', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', & + 'soa_c2' /) + real(kind=r8), parameter :: specmw_so4_amode = 115.10733999999999_r8 +end module modal_aero_data + +module carma_intr + implicit none + public :: carma_get_group_by_name, carma_get_dry_radius +contains + subroutine carma_get_group_by_name(short_name, igroup, rc) + character(len=*), intent(in) :: short_name + integer, intent(out) :: igroup + integer, intent(out) :: rc + if (trim(adjustl(short_name)) == 'PRSUL') then + igroup = 1 + else if (trim(adjustl(short_name)) == 'MXAER') then + igroup = 2 + else + igroup = 0 + end if + rc = 0 + end subroutine carma_get_group_by_name + subroutine carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + use physics_types, only: physics_state + use shr_kind_mod, only: r8 => shr_kind_r8 + type(physics_state), intent(in) :: state + integer, intent(in) :: igroup + integer, intent(in) :: ibin + real(kind=r8), intent(out) :: dryr(:,:) + real(kind=r8), intent(out) :: rho(:,:) + integer, intent(out) :: rc + dryr(:,:) = 1.0e-7_r8 ! m + rho(:,:) = 1.0e-11_r8 ! kg m-3 + rc = 0 + end subroutine carma_get_dry_radius +end module carma_intr + + diff --git a/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_MAM.F90 b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_MAM.F90 new file mode 100644 index 0000000000..b8b0f4ef1e --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_MAM.F90 @@ -0,0 +1,236 @@ +! Mocked dependencies of cloud aqueous chemistry module +module chemistry_test_data + implicit none + public + logical :: do_debug_logging = .false. + integer :: debug_column = -1 + integer :: debug_level = -1 +end module chemistry_test_data + +module shr_kind_mod + implicit none + public :: shr_kind_r8 + integer, parameter :: shr_kind_r8 = kind(0.0d0) +end module shr_kind_mod + +module spmd_utils + implicit none + public :: masterproc + logical :: masterproc = .true. +end module spmd_utils + +module cam_logfile + implicit none + public :: iulog + integer, parameter :: iulog = 6 +end module cam_logfile + +module physics_buffer + implicit none + public :: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + integer, parameter :: dtype_r8 = 1 + integer, parameter :: pbuf_get_index = 1 + integer, parameter :: pbuf_add_field = 1 + type :: physics_buffer_desc + end type physics_buffer_desc +end module physics_buffer + +module physics_types + implicit none + public :: physics_state + type :: physics_state + end type physics_state +end module physics_types + +module mo_chem_utls + implicit none + public :: get_spc_ndx, get_inv_ndx +contains + integer function get_spc_ndx(spc_name) + character(len=*), intent(in) :: spc_name + select case (trim(adjustl(spc_name))) + case ('SO2') + get_spc_ndx = 18 + case ('H2O2') + get_spc_ndx = 7 + case ('SO4') + get_spc_ndx = 0 + case ('H2SO4') + get_spc_ndx = 8 + case default + get_spc_ndx = -1 + end select + end function get_spc_ndx + integer function get_inv_ndx(inv_name) + character(len=*), intent(in) :: inv_name + select case (trim(adjustl(inv_name))) + case ('O3') + get_inv_ndx = 4 + case ('HO2') + get_inv_ndx = 6 + case default + get_inv_ndx = -1 + end select + end function get_inv_ndx +end module mo_chem_utls + +module carma_flags_mod + implicit none + public :: carma_do_cloudborne + logical, parameter :: carma_do_cloudborne = .false. +end module carma_flags_mod + +module phys_control + implicit none + public :: phys_getopts, cam_chempkg_is +contains + subroutine phys_getopts(prog_modal_aero_out, history_aerosol_out) + logical, optional, intent(out) :: prog_modal_aero_out + logical, optional, intent(out) :: history_aerosol_out + if (present(prog_modal_aero_out)) then + prog_modal_aero_out = .true. + end if + if (present(history_aerosol_out)) then + history_aerosol_out = .false. + end if + end subroutine phys_getopts + logical function cam_chempkg_is(pkg) + character(len=*), intent(in) :: pkg + cam_chempkg_is = .false. + end function cam_chempkg_is +end module phys_control + +module ppgrid + implicit none + public :: pcols, pver + integer, parameter :: pcols = 16 + integer, parameter :: pver = 32 +end module ppgrid + +module chem_mods + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: gas_pcnst, nfs, adv_mass + integer, parameter :: gas_pcnst = 26 + integer, parameter :: nfs = 1 + real(kind=r8), parameter :: adv_mass(*) = (/ & + 12.010999999999999_r8, 12.010999999999999_r8, 62.132399999999997_r8, & + 135.06403900000001_r8, 135.06403900000001_r8, 135.06403900000001_r8, 34.013599999999997_r8, & + 98.078400000000002_r8, 58.442467999999998_r8, 58.442467999999998_r8, 58.442467999999998_r8, & + 1.0074000000000001_r8, 1.0074000000000001_r8, 1.0074000000000001_r8, 1.0074000000000001_r8, & + 12.010999999999999_r8, 12.010999999999999_r8, 64.064800000000005_r8, 115.10733999999999_r8, & + 115.10733999999999_r8, 115.10733999999999_r8, 12.010999999999999_r8, 12.010999999999999_r8, & + 12.010999999999999_r8, 12.010999999999999_r8, 18.014199999999999_r8 /) +end module chem_mods + +module physconst + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: mwdry, gravit + real(kind=shr_kind_r8), parameter :: mwdry = -999.0_shr_kind_r8 + real(kind=shr_kind_r8), parameter :: gravit = 9.7976399999999995_shr_kind_r8 +end module physconst + +module mo_constants + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: pi + real(kind=shr_kind_r8), parameter :: pi = 3.1415926535897931_shr_kind_r8 +end module mo_constants + +module cam_abortutils + implicit none + public :: endrun +contains + subroutine endrun(msg) + character(len=*), intent(in) :: msg + write(*,*) msg + stop 3 + end subroutine endrun +end module cam_abortutils + +module rad_constituents + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx +contains + subroutine rad_cnst_get_info(list_idx, nbins) + integer, intent(in) :: list_idx + integer, optional, intent(out) :: nbins + if(present(nbins)) then + nbins = 0 + end if + end subroutine rad_cnst_get_info + subroutine rad_cnst_get_info_by_bin(list_idx, bin_idx, nspec, bin_name) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, optional, intent(out) :: nspec + character(len=*), optional, intent(out) :: bin_name + if(present(bin_name)) then + bin_name = 'something' + end if + if(present(nspec)) then + nspec = 0 + end if + end subroutine rad_cnst_get_info_by_bin + subroutine rad_cnst_get_bin_props_by_idx(list_idx, bin_idx, spec_idx, spectype) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + character(len=*), optional, intent(out) :: spectype + if(present(spectype)) then + spectype = 'something else' + end if + end subroutine rad_cnst_get_bin_props_by_idx +end module rad_constituents + +module aerosol_properties_mod + implicit none + public :: aero_name_len + integer, parameter :: aero_name_len = 32 +end module aerosol_properties_mod + +module modal_aero_data + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode, & + numptrcw_amode, lptr_nh4_cw_amode, cnst_name_cw, specmw_so4_amode + integer, parameter :: ntot_amode = 4 + integer, parameter :: modeptr_accum = 1 + integer, parameter :: lptr_so4_cw_amode(*) = (/ 28, 29, 30, -999888777 /) + integer, parameter :: lptr_msa_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + integer, parameter :: numptrcw_amode(*) = (/ 21, 22, 23, 24 /) + integer, parameter :: lptr_nh4_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + character(len=6), parameter :: cnst_name_cw(*) = (/ & + ' bc_c1', ' bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'num_c1', & + 'num_c2', 'num_c3', 'num_c4', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', & + 'soa_c2' /) + real(kind=r8), parameter :: specmw_so4_amode = 115.10733999999999_r8 +end module modal_aero_data + + +module carma_intr + implicit none + public :: carma_get_group_by_name, carma_get_dry_radius +contains + subroutine carma_get_group_by_name(short_name, igroup, rc) + character(len=*), intent(in) :: short_name + integer, intent(out) :: igroup + integer, intent(out) :: rc + igroup = 1 + rc = 0 + end subroutine carma_get_group_by_name + subroutine carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + use physics_types, only: physics_state + use shr_kind_mod, only: r8 => shr_kind_r8 + type(physics_state), intent(in) :: state + integer, intent(in) :: igroup + integer, intent(in) :: ibin + real(kind=r8), intent(out) :: dryr(:,:) + real(kind=r8), intent(out) :: rho(:,:) + integer, intent(out) :: rc + dryr(:,:) = 0.0_r8 ! m + rho(:,:) = 0.0_r8 ! kg m-3 + rc = 0 + end subroutine carma_get_dry_radius +end module carma_intr diff --git a/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_full.F90 b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_full.F90 new file mode 100644 index 0000000000..30f7b2082e --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/cloud_chemistry_dependencies_full.F90 @@ -0,0 +1,245 @@ +! Mocked dependencies of cloud aqueous chemistry module +! modified to include randomly generated data for species +! not included in the configuration used to generate the +! snapshot file. +module chemistry_test_data + implicit none + public + logical :: do_debug_logging = .false. + integer :: debug_column = 13 + integer :: debug_level = 26 +end module chemistry_test_data + +module shr_kind_mod + implicit none + public :: shr_kind_r8 + integer, parameter :: shr_kind_r8 = kind(0.0d0) +end module shr_kind_mod + +module spmd_utils + implicit none + public :: masterproc + logical :: masterproc = .true. +end module spmd_utils + +module cam_logfile + implicit none + public :: iulog + integer, parameter :: iulog = 6 +end module cam_logfile + +module physics_buffer + implicit none + public :: physics_buffer_desc, pbuf_get_index, pbuf_add_field, dtype_r8 + integer, parameter :: dtype_r8 = 1 + integer, parameter :: pbuf_get_index = 1 + integer, parameter :: pbuf_add_field = 1 + type :: physics_buffer_desc + end type physics_buffer_desc +end module physics_buffer + +module physics_types + implicit none + public :: physics_state + type :: physics_state + end type physics_state +end module physics_types + +module mo_chem_utls + implicit none + public :: get_spc_ndx, get_inv_ndx +contains + integer function get_spc_ndx(spc_name) + character(len=*), intent(in) :: spc_name + select case (trim(adjustl(spc_name))) + case ('SO2') + get_spc_ndx = 18 + case ('H2O2') + get_spc_ndx = 7 + case ('SO4') + get_spc_ndx = 0 + case ('H2SO4') + get_spc_ndx = 8 + case ('NH3') + get_spc_ndx = 1 + case ('HNO3') + get_spc_ndx = 2 + case ('MSA') + get_spc_ndx = 3 + case default + get_spc_ndx = -1 + end select + end function get_spc_ndx + integer function get_inv_ndx(inv_name) + character(len=*), intent(in) :: inv_name + select case (trim(adjustl(inv_name))) + case ('O3') + get_inv_ndx = 4 + case ('HO2') + get_inv_ndx = 6 + case default + get_inv_ndx = -1 + end select + end function get_inv_ndx +end module mo_chem_utls + +module carma_flags_mod + implicit none + public :: carma_do_cloudborne + logical, parameter :: carma_do_cloudborne = .false. +end module carma_flags_mod + +module phys_control + implicit none + public :: phys_getopts, cam_chempkg_is +contains + subroutine phys_getopts(prog_modal_aero_out, history_aerosol_out) + logical, optional, intent(out) :: prog_modal_aero_out + logical, optional, intent(out) :: history_aerosol_out + if (present(prog_modal_aero_out)) then + prog_modal_aero_out = .true. + end if + if (present(history_aerosol_out)) then + history_aerosol_out = .false. + end if + end subroutine phys_getopts + logical function cam_chempkg_is(pkg) + character(len=*), intent(in) :: pkg + cam_chempkg_is = .false. + end function cam_chempkg_is +end module phys_control + +module ppgrid + implicit none + public :: pcols, pver + integer, parameter :: pcols = 16 + integer, parameter :: pver = 32 +end module ppgrid + +module chem_mods + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: gas_pcnst, nfs, adv_mass + integer, parameter :: gas_pcnst = 26 + integer, parameter :: nfs = 1 + real(kind=r8), parameter :: adv_mass(*) = (/ & + 12.010999999999999_r8, 12.010999999999999_r8, 62.132399999999997_r8, & + 135.06403900000001_r8, 135.06403900000001_r8, 135.06403900000001_r8, 34.013599999999997_r8, & + 98.078400000000002_r8, 58.442467999999998_r8, 58.442467999999998_r8, 58.442467999999998_r8, & + 1.0074000000000001_r8, 1.0074000000000001_r8, 1.0074000000000001_r8, 1.0074000000000001_r8, & + 12.010999999999999_r8, 12.010999999999999_r8, 64.064800000000005_r8, 115.10733999999999_r8, & + 115.10733999999999_r8, 115.10733999999999_r8, 12.010999999999999_r8, 12.010999999999999_r8, & + 12.010999999999999_r8, 12.010999999999999_r8, 18.014199999999999_r8 /) +end module chem_mods + +module physconst + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: mwdry, gravit + real(kind=shr_kind_r8), parameter :: mwdry = -999.0_shr_kind_r8 + real(kind=shr_kind_r8), parameter :: gravit = 9.7976399999999995_shr_kind_r8 +end module physconst + +module mo_constants + use shr_kind_mod, only : shr_kind_r8 + implicit none + public :: pi + real(kind=shr_kind_r8), parameter :: pi = 3.1415926535897931_shr_kind_r8 +end module mo_constants + +module cam_abortutils + implicit none + public :: endrun +contains + subroutine endrun(msg) + character(len=*), intent(in) :: msg + write(*,*) msg + stop 3 + end subroutine endrun +end module cam_abortutils + +module rad_constituents + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: rad_cnst_get_info, rad_cnst_get_info_by_bin, rad_cnst_get_bin_props_by_idx +contains + subroutine rad_cnst_get_info(list_idx, nbins) + integer, intent(in) :: list_idx + integer, optional, intent(out) :: nbins + if(present(nbins)) then + nbins = 0 + end if + end subroutine rad_cnst_get_info + subroutine rad_cnst_get_info_by_bin(list_idx, bin_idx, nspec, bin_name) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, optional, intent(out) :: nspec + character(len=*), optional, intent(out) :: bin_name + if(present(bin_name)) then + bin_name = 'something' + end if + if(present(nspec)) then + nspec = 0 + end if + end subroutine rad_cnst_get_info_by_bin + subroutine rad_cnst_get_bin_props_by_idx(list_idx, bin_idx, spec_idx, spectype) + integer, intent(in) :: list_idx + integer, intent(in) :: bin_idx + integer, intent(in) :: spec_idx + character(len=*), optional, intent(out) :: spectype + if(present(spectype)) then + spectype = 'something else' + end if + end subroutine rad_cnst_get_bin_props_by_idx +end module rad_constituents + +module aerosol_properties_mod + implicit none + public :: aero_name_len + integer, parameter :: aero_name_len = 32 +end module aerosol_properties_mod + +module modal_aero_data + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + public :: ntot_amode, modeptr_accum, lptr_so4_cw_amode, lptr_msa_cw_amode, & + numptrcw_amode, lptr_nh4_cw_amode, cnst_name_cw, specmw_so4_amode + integer, parameter :: ntot_amode = 4 + integer, parameter :: modeptr_accum = 1 + integer, parameter :: lptr_so4_cw_amode(*) = (/ 28, 29, 30, -999888777 /) + integer, parameter :: lptr_msa_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + integer, parameter :: numptrcw_amode(*) = (/ 21, 22, 23, 24 /) + integer, parameter :: lptr_nh4_cw_amode(*) = (/ -999888777, -999888777, -999888777, -999888777 /) + character(len=6), parameter :: cnst_name_cw(*) = (/ & + ' bc_c1', ' bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c2', 'ncl_c3', 'num_c1', & + 'num_c2', 'num_c3', 'num_c4', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', & + 'soa_c2' /) + real(kind=r8), parameter :: specmw_so4_amode = 115.10733999999999_r8 +end module modal_aero_data + + +module carma_intr + implicit none + public :: carma_get_group_by_name, carma_get_dry_radius +contains + subroutine carma_get_group_by_name(short_name, igroup, rc) + character(len=*), intent(in) :: short_name + integer, intent(out) :: igroup + integer, intent(out) :: rc + igroup = 1 + rc = 0 + end subroutine carma_get_group_by_name + subroutine carma_get_dry_radius(state, igroup, ibin, dryr, rho, rc) + use physics_types, only: physics_state + use shr_kind_mod, only: r8 => shr_kind_r8 + type(physics_state), intent(in) :: state + integer, intent(in) :: igroup + integer, intent(in) :: ibin + real(kind=r8), intent(out) :: dryr(:,:) + real(kind=r8), intent(out) :: rho(:,:) + integer, intent(out) :: rc + dryr(:,:) = 0.0_r8 ! m + rho(:,:) = 0.0_r8 ! kg m-3 + rc = 0 + end subroutine carma_get_dry_radius +end module carma_intr \ No newline at end of file diff --git a/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_BAM.F90 b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_BAM.F90 new file mode 100644 index 0000000000..c892cc50d5 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_BAM.F90 @@ -0,0 +1,831 @@ +module test_cloud_aqueous_chemistry_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! No invariants are needed for BAM +#define NO_INVARIANTS + + implicit none + + integer, parameter :: n_ranks = 29 + integer, parameter :: n_timesteps = 1 + integer, parameter :: n_lat = 19 + integer, parameter :: n_lon = 24 + integer, parameter :: n_columns_per_rank = 16 + integer, parameter :: n_layers = 26 + integer, parameter :: n_invariants = 4 + integer, parameter :: n_species = 103 + integer, parameter :: n_modes = 1 + +#ifndef NO_INVARIANTS + integer, parameter :: needed_invariant_indices(0) = (/ /) +#endif + integer, parameter :: needed_species_indices(*) = (/ 1, 8, 13, 14, 83, 85, 86 /) + + character(len=*), parameter :: data_file = & + '../test/chemistry/data/QPMOZ-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc' + + type :: chemistry_args + integer :: ncol + integer :: lchnk + integer :: loffset + real(r8) :: dtime + real(r8) :: time + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8), allocatable :: pres(:,:) + real(r8), allocatable :: pdel(:,:) + real(r8), allocatable :: tfld(:,:) + real(r8), allocatable :: mbar(:,:) + real(r8), allocatable :: lwc(:,:) + real(r8), allocatable :: cldfrc(:,:) + real(r8), allocatable :: cldnum(:,:) + real(r8), allocatable :: xhnm(:,:) + real(r8), allocatable :: invariants(:,:,:) + real(r8), allocatable :: qcw(:,:,:) + real(r8), allocatable :: qin(:,:,:) + real(r8), allocatable :: xphlwc(:,:) + real(r8), allocatable :: aqso4(:,:) + real(r8), allocatable :: aqh2so4(:,:) + real(r8), allocatable :: aqso4_h2o2(:) + real(r8), allocatable :: aqso4_o3(:) + end type chemistry_args + + interface read_and_condense_columns + module procedure read_and_condense_columns_2D + module procedure read_and_condense_columns_1D + end interface read_and_condense_columns + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .true. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Primary rank test against snapshot passed' + else + write(*,*) 'Primary rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_primary_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Other rank test against snapshot passed' + else + write(*,*) 'Other rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(new_args, old_args)) then + write(*,*) 'Primary rank test against original module passed' + else + write(*,*) 'Primary rank test against original module failed' + stop 3 + end if + + end subroutine test_as_primary_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(new_args, old_args)) then + write(*,*) 'Other rank test against original module passed' + else + write(*,*) 'Other rank test against original module failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_inputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + type(file_io_t), pointer :: file + + integer :: i, j, i_time, i_lat, i_lon + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:), lats(:), lons(:) + + call initialize_args(chem_args) + file => file_io_t(data_file) + + allocate(temp1d(1)) + call file%read('time', temp1d) + do i = 1, size(chem_args) + chem_args(i)%time = temp1d(1) + end do + allocate(lats(n_lat)) + allocate(lons(n_lon)) + call file%read('lat', lats) + call file%read('lon', lons) + i = 1 + j = 0 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + j = j+1 + if (j>n_columns_per_rank) then + i = i + 1 + j = 1 + end if + chem_args(i)%lat(j) = lats(i_lat) + chem_args(i)%lon(j) = lons(i_lon) + end do + end do + end do + call read_and_condense_columns(file, 'cloud_press_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pres = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_pdel_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pdel = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_tfld_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%tfld = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_mbar_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%mbar = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_lwc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%lwc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldfrc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldfrc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldnum_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldnum = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_xhnm_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xhnm = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do i = 1, size(chem_args) + chem_args(i)%invariants = 0.0_r8 + end do +#ifndef NO_INVARIANTS + do j = 1, size(needed_invariant_indices) + write(index_string, '(I3)') needed_invariant_indices(j) + call read_and_condense_columns(file, 'cloud_invariants_'// & + trim(adjustl(index_string))//'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%invariants(:,:,needed_invariant_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do +#endif + do i = 1, size(chem_args) + chem_args(i)%qcw = 0.0_r8 + chem_args(i)%qin = 0.0_r8 + end do + do j = 1, size(needed_species_indices) + write(index_string, '(I3)') needed_species_indices(j) + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do i = 1, size(chem_args) + chem_args(i)%xphlwc = -1.0e300_r8 + chem_args(i)%aqso4 = -1.0e300_r8 + chem_args(i)%aqh2so4 = -1.0e300_r8 + chem_args(i)%aqso4_h2o2 = -1.0e300_r8 + chem_args(i)%aqso4_o3 = -1.0e300_r8 + end do + deallocate(file) + + end function get_inputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_expected_outputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + + type(file_io_t), pointer :: file + integer :: i, j + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:) + + chem_args = get_inputs() + file => file_io_t(data_file) + do i = 1, size(chem_args) + chem_args(i)%qcw = 0.0_r8 + chem_args(i)%qin = 0.0_r8 + end do + do j = 1, size(needed_species_indices) + write(index_string, '(I3)') needed_species_indices(j) + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + call read_and_condense_columns(file, 'cloud_xphlwc_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xphlwc(:,:) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_modes + write(index_string, '(I3)') j + call read_and_condense_columns(file, & + 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, & + 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqh2so4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + end do + call read_and_condense_columns(file, 'cloud_aqso4_h2o2_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_h2o2(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, 'cloud_aqso4_o3_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_o3(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + deallocate(file) + + end function get_expected_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine initialize_args(chem_args) + + type(chemistry_args), allocatable, intent(inout) :: chem_args(:) + + integer :: i + + if (allocated(chem_args)) deallocate(chem_args) + allocate(chem_args(n_ranks)) + do i = 1, size(chem_args) + chem_args(i)%ncol = min(n_columns_per_rank, n_lat*n_lon - & + (i-1)*n_columns_per_rank) + chem_args(i)%lchnk = 37 + chem_args(i)%loffset = 3 + chem_args(i)%dtime = 1800.0_r8 + allocate(chem_args(i)%lat(chem_args(i)%ncol)) + allocate(chem_args(i)%lon(chem_args(i)%ncol)) + allocate(chem_args(i)%pres(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%pdel(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%tfld(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%mbar(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%lwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldfrc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldnum(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%xhnm(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%invariants(chem_args(i)%ncol, n_layers, & + n_invariants)) + allocate(chem_args(i)%qcw(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%qin(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%xphlwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%aqso4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqh2so4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqso4_h2o2(chem_args(i)%ncol)) + allocate(chem_args(i)%aqso4_o3(chem_args(i)%ncol)) + end do + + end subroutine initialize_args + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_2D(file, variable_name, data, dim2) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:), allocatable, intent(inout) :: data + integer, intent(in) :: dim2 + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps, dim2)) + allocate(temp(n_lon, n_lat, dim2, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col,:) = temp(i_lon,i_lat,:,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_2D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_1D(file, variable_name, data) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:), allocatable, intent(inout) :: data + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps)) + allocate(temp(n_lon, n_lat, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col) = temp(i_lon,i_lat,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_1D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function compare_outputs(calculated, expected, relative_tolerance, & + absolute_tolerance) result(passed) + + type(chemistry_args), intent(in) :: calculated(:) + type(chemistry_args), intent(in) :: expected(:) + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + integer :: i, j, k, l + passed = .true. + + do i = 1, size(calculated) + do j = 1, calculated(i)%ncol + do k = 1, n_layers + if (.not. check_close(calculated(i)%pres(j,k), & + expected(i)%pres(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pres mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pres(j,k), ' expected: ', & + expected(i)%pres(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%pdel(j,k), & + expected(i)%pdel(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pdel mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pdel(j,k), ' expected: ', & + expected(i)%pdel(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%tfld(j,k), & + expected(i)%tfld(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'tfld mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%tfld(j,k), ' expected: ', & + expected(i)%tfld(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%mbar(j,k), & + expected(i)%mbar(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'mbar mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%mbar(j,k), ' expected: ', & + expected(i)%mbar(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%lwc(j,k), & + expected(i)%lwc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'lwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%lwc(j,k), ' expected: ', & + expected(i)%lwc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldfrc(j,k), & + expected(i)%cldfrc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldfrc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldfrc(j,k), ' expected: ', & + expected(i)%cldfrc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldnum(j,k), & + expected(i)%cldnum(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldnum mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldnum(j,k), ' expected: ', & + expected(i)%cldnum(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%xhnm(j,k), & + expected(i)%xhnm(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'xhnm mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xhnm(j,k), ' expected: ', & + expected(i)%xhnm(j,k) + passed = .false. + end if + do l = 1, n_invariants + if (.not. check_close(calculated(i)%invariants(j,k,l), & + expected(i)%invariants(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'invariants mismatch at column ', (i-1)*j, ' and layer ', & + k, ' and invariant ', l, ' calculated: ', & + calculated(i)%invariants(j,k,l), ' expected: ', & + expected(i)%invariants(j,k,l) + passed = .false. + end if + end do + do l = 1, n_species + if (.not. check_close(calculated(i)%qcw(j,k,l), & + expected(i)%qcw(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qcw mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qcw(j,k,l), & + ' expected: ', expected(i)%qcw(j,k,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%qin(j,k,l), & + expected(i)%qin(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qin mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qin(j,k,l), & + ' expected: ', expected(i)%qin(j,k,l) + passed = .false. + end if + end do + if (.not. check_close(calculated(i)%xphlwc(j,k), & + expected(i)%xphlwc(j,k), relative_tolerance, & + absolute_tolerance)) then + print *, 'xphlwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xphlwc(j,k), ' expected: ', & + expected(i)%xphlwc(j,k) + passed = .false. + end if +! These outputs are never calculated in the original BAM code +#if 0 + do l = 1, n_modes-1 ! the last mode is not actually set in the origical code + if (.not. check_close(calculated(i)%aqso4(j,l), & + expected(i)%aqso4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4 mismatch at column ', (i-1)*j, ' and mode ', l, & + ' calculated: ', calculated(i)%aqso4(j,l), ' expected: ', & + expected(i)%aqso4(j,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqh2so4(j,l), & + expected(i)%aqh2so4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqh2so4 mismatch at column ', (i-1)*j, ' and mode ', & + l, ' calculated: ', calculated(i)%aqh2so4(j,l), ' expected: ',& + expected(i)%aqh2so4(j,l) + passed = .false. + end if + end do +#endif + end do +! These outputs are never calculated in the original BAM code +#if 0 + if (.not. check_close(calculated(i)%aqso4_h2o2(j), & + expected(i)%aqso4_h2o2(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_h2o2 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_h2o2(j), ' expected: ', & + expected(i)%aqso4_h2o2(j) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqso4_o3(j), & + expected(i)%aqso4_o3(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_o3 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_o3(j), ' expected: ', & + expected(i)%aqso4_o3(j) + passed = .false. + end if +#endif + end do + end do + + end function compare_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function check_close(a, b, relative_tolerance, absolute_tolerance) + + real(r8), intent(in) :: a, b + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + real(r8) :: l_rel_tol = 1.0e-13_r8 + real(r8) :: l_abs_tol = 0.0_r8 + + if (present(relative_tolerance)) l_rel_tol = relative_tolerance + if (present(absolute_tolerance)) l_abs_tol = absolute_tolerance + check_close = abs(a - b) <= & + (abs(a) + abs(b))/2.0_r8 * l_rel_tol + l_abs_tol + + end function check_close + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module test_cloud_aqueous_chemistry_mod + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program test_cloud_aqueous_chemistry + + use test_cloud_aqueous_chemistry_mod, only: & + test_as_primary_rank_against_snapshot, & + test_as_other_rank_against_snapshot, & + test_as_primary_against_original_module, & + test_as_other_rank_against_original_module + + call test_as_primary_rank_against_snapshot() + call test_as_other_rank_against_snapshot() + call test_as_primary_against_original_module() + call test_as_other_rank_against_original_module() + +end program test_cloud_aqueous_chemistry + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \ No newline at end of file diff --git a/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_CARMA.F90 b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_CARMA.F90 new file mode 100644 index 0000000000..371902bf2e --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_CARMA.F90 @@ -0,0 +1,840 @@ +module test_cloud_aqueous_chemistry_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + +! No invariants are needed for CARMA +#define NO_INVARIANTS + + implicit none + + integer, parameter :: n_ranks = 29 + integer, parameter :: n_timesteps = 1 + integer, parameter :: n_lat = 19 + integer, parameter :: n_lon = 24 + integer, parameter :: n_columns_per_rank = 16 + integer, parameter :: n_layers = 32 + integer, parameter :: n_invariants = 3 + integer, parameter :: n_species = 202 + integer, parameter :: n_modes = 40 + +#ifndef NO_INVARIANTS + integer, parameter :: needed_invariant_indices(0) = (/ /) +#endif + + integer, parameter :: needed_species_indices(*) = (/ 74, 75, 84, 112, 122, 137, 176 /) + integer, parameter :: extra_qcw_indices(*) = (/ 1, 11, 21, 31, 41, 51, 61, & + 71, 81, 91, 101, 111, 121, 131, & + 141, 151, 161, 171, 181, 191 /) + + character(len=*), parameter :: data_file = & + '../test/chemistry/data/QPCARMATS-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc' + + type :: chemistry_args + integer :: ncol + integer :: lchnk + integer :: loffset + real(r8) :: dtime + real(r8) :: time + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8), allocatable :: pres(:,:) + real(r8), allocatable :: pdel(:,:) + real(r8), allocatable :: tfld(:,:) + real(r8), allocatable :: mbar(:,:) + real(r8), allocatable :: lwc(:,:) + real(r8), allocatable :: cldfrc(:,:) + real(r8), allocatable :: cldnum(:,:) + real(r8), allocatable :: xhnm(:,:) + real(r8), allocatable :: invariants(:,:,:) + real(r8), allocatable :: qcw(:,:,:) + real(r8), allocatable :: qin(:,:,:) + real(r8), allocatable :: xphlwc(:,:) + real(r8), allocatable :: aqso4(:,:) + real(r8), allocatable :: aqh2so4(:,:) + real(r8), allocatable :: aqso4_h2o2(:) + real(r8), allocatable :: aqso4_o3(:) + end type chemistry_args + + interface read_and_condense_columns + module procedure read_and_condense_columns_2D + module procedure read_and_condense_columns_1D + end interface read_and_condense_columns + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .true. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Primary rank test against snapshot passed' + else + write(*,*) 'Primary rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_primary_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Other rank test against snapshot passed' + else + write(*,*) 'Other rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(new_args, old_args)) then + write(*,*) 'Primary rank test against original module passed' + else + write(*,*) 'Primary rank test against original module failed' + stop 3 + end if + + end subroutine test_as_primary_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (compare_outputs(new_args, old_args)) then + write(*,*) 'Other rank test against original module passed' + else + write(*,*) 'Other rank test against original module failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_inputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + type(file_io_t), pointer :: file + + integer :: i, j, i_time, i_lat, i_lon + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:), lats(:), lons(:) + + call initialize_args(chem_args) + file => file_io_t(data_file) + + allocate(temp1d(1)) + call file%read('time', temp1d) + do i = 1, size(chem_args) + chem_args(i)%time = temp1d(1) + end do + allocate(lats(n_lat)) + allocate(lons(n_lon)) + call file%read('lat', lats) + call file%read('lon', lons) + i = 1 + j = 0 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + j = j+1 + if (j>n_columns_per_rank) then + i = i + 1 + j = 1 + end if + chem_args(i)%lat(j) = lats(i_lat) + chem_args(i)%lon(j) = lons(i_lon) + end do + end do + end do + call read_and_condense_columns(file, 'cloud_press_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pres = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_pdel_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pdel = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_tfld_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%tfld = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_mbar_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%mbar = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_lwc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%lwc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldfrc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldfrc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldnum_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldnum = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_xhnm_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xhnm = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + ! No invariants in BAM configuration + do i = 1, size(chem_args) + chem_args(i)%invariants = 0.0_r8 + end do +#ifndef NO_INVARIANTS + do j = 1, size(needed_invariant_indices) + write(index_string, '(I3)') needed_invariant_indices(j) + call read_and_condense_columns(file, 'cloud_invariants_'// & + trim(adjustl(index_string))//'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%invariants(:,:,needed_invariant_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do +#endif + do i = 1, size(chem_args) + chem_args(i)%qcw = 0.0_r8 + chem_args(i)%qin = 0.0_r8 + end do + do j = 1, size(needed_species_indices) + write(index_string, '(I3)') needed_species_indices(j) + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do i = 1, size(chem_args) + chem_args(i)%xphlwc = -1.0e300_r8 + chem_args(i)%aqso4 = -1.0e300_r8 + chem_args(i)%aqh2so4 = -1.0e300_r8 + chem_args(i)%aqso4_h2o2 = -1.0e300_r8 + chem_args(i)%aqso4_o3 = -1.0e300_r8 + end do + deallocate(file) + + end function get_inputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_expected_outputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + + type(file_io_t), pointer :: file + integer :: i, j + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:) + + chem_args = get_inputs() + file => file_io_t(data_file) + do i = 1, size(chem_args) + chem_args(i)%qcw = 0.0_r8 + chem_args(i)%qin = 0.0_r8 + end do + do j = 1, size(needed_species_indices) + write(index_string, '(I3)') needed_species_indices(j) + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,needed_species_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do j = 1, size(extra_qcw_indices) + write(index_string, '(I3)') extra_qcw_indices(j) + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,extra_qcw_indices(j)) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + call read_and_condense_columns(file, 'cloud_xphlwc_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xphlwc(:,:) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_modes + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, & + 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqh2so4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + end do + call read_and_condense_columns(file, 'cloud_aqso4_h2o2_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_h2o2(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, 'cloud_aqso4_o3_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_o3(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + deallocate(file) + + end function get_expected_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine initialize_args(chem_args) + + type(chemistry_args), allocatable, intent(inout) :: chem_args(:) + + integer :: i + + if (allocated(chem_args)) deallocate(chem_args) + allocate(chem_args(n_ranks)) + do i = 1, size(chem_args) + chem_args(i)%ncol = min(n_columns_per_rank, n_lat*n_lon - & + (i-1)*n_columns_per_rank) + chem_args(i)%lchnk = 37 + chem_args(i)%loffset = 9 + chem_args(i)%dtime = 1800.0_r8 + allocate(chem_args(i)%lat(chem_args(i)%ncol)) + allocate(chem_args(i)%lon(chem_args(i)%ncol)) + allocate(chem_args(i)%pres(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%pdel(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%tfld(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%mbar(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%lwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldfrc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldnum(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%xhnm(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%invariants(chem_args(i)%ncol, n_layers, & + n_invariants)) + ! CARMA has an extra 18 elements in the third dimension of qcw for some reason + allocate(chem_args(i)%qcw(chem_args(i)%ncol, n_layers, n_species+18)) + allocate(chem_args(i)%qin(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%xphlwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%aqso4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqh2so4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqso4_h2o2(chem_args(i)%ncol)) + allocate(chem_args(i)%aqso4_o3(chem_args(i)%ncol)) + end do + + end subroutine initialize_args + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_2D(file, variable_name, data, dim2) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:), allocatable, intent(inout) :: data + integer, intent(in) :: dim2 + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps, dim2)) + allocate(temp(n_lon, n_lat, dim2, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col,:) = temp(i_lon,i_lat,:,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_2D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_1D(file, variable_name, data) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:), allocatable, intent(inout) :: data + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps)) + allocate(temp(n_lon, n_lat, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col) = temp(i_lon,i_lat,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_1D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function compare_outputs(calculated, expected, relative_tolerance, & + absolute_tolerance) result(passed) + + type(chemistry_args), intent(in) :: calculated(:) + type(chemistry_args), intent(in) :: expected(:) + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + integer :: i, j, k, l + passed = .true. + + do i = 1, size(calculated) + do j = 1, calculated(i)%ncol + do k = 1, n_layers + if (.not. check_close(calculated(i)%pres(j,k), & + expected(i)%pres(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pres mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pres(j,k), ' expected: ', & + expected(i)%pres(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%pdel(j,k), & + expected(i)%pdel(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pdel mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pdel(j,k), ' expected: ', & + expected(i)%pdel(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%tfld(j,k), & + expected(i)%tfld(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'tfld mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%tfld(j,k), ' expected: ', & + expected(i)%tfld(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%mbar(j,k), & + expected(i)%mbar(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'mbar mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%mbar(j,k), ' expected: ', & + expected(i)%mbar(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%lwc(j,k), & + expected(i)%lwc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'lwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%lwc(j,k), ' expected: ', & + expected(i)%lwc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldfrc(j,k), & + expected(i)%cldfrc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldfrc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldfrc(j,k), ' expected: ', & + expected(i)%cldfrc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldnum(j,k), & + expected(i)%cldnum(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldnum mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldnum(j,k), ' expected: ', & + expected(i)%cldnum(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%xhnm(j,k), & + expected(i)%xhnm(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'xhnm mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xhnm(j,k), ' expected: ', & + expected(i)%xhnm(j,k) + passed = .false. + end if + do l = 1, n_invariants + if (.not. check_close(calculated(i)%invariants(j,k,l), & + expected(i)%invariants(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'invariants mismatch at column ', (i-1)*j, ' and layer ', & + k, ' and invariant ', l, ' calculated: ', & + calculated(i)%invariants(j,k,l), ' expected: ', & + expected(i)%invariants(j,k,l) + passed = .false. + end if + end do + do l = 1, n_species + if (.not. check_close(calculated(i)%qcw(j,k,l), & + expected(i)%qcw(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qcw mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qcw(j,k,l), & + ' expected: ', expected(i)%qcw(j,k,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%qin(j,k,l), & + expected(i)%qin(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qin mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qin(j,k,l), & + ' expected: ', expected(i)%qin(j,k,l) + passed = .false. + end if + end do + if (.not. check_close(calculated(i)%xphlwc(j,k), & + expected(i)%xphlwc(j,k), relative_tolerance, & + absolute_tolerance)) then + print *, 'xphlwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xphlwc(j,k), ' expected: ', & + expected(i)%xphlwc(j,k) + passed = .false. + end if + do l = 1, n_modes-1 ! the last mode is not actually set in the origical code + if (.not. check_close(calculated(i)%aqso4(j,l), & + expected(i)%aqso4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4 mismatch at column ', (i-1)*j, ' and mode ', l, & + ' calculated: ', calculated(i)%aqso4(j,l), ' expected: ', & + expected(i)%aqso4(j,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqh2so4(j,l), & + expected(i)%aqh2so4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqh2so4 mismatch at column ', (i-1)*j, ' and mode ', & + l, ' calculated: ', calculated(i)%aqh2so4(j,l), ' expected: ',& + expected(i)%aqh2so4(j,l) + passed = .false. + end if + end do + end do + if (.not. check_close(calculated(i)%aqso4_h2o2(j), & + expected(i)%aqso4_h2o2(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_h2o2 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_h2o2(j), ' expected: ', & + expected(i)%aqso4_h2o2(j) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqso4_o3(j), & + expected(i)%aqso4_o3(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_o3 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_o3(j), ' expected: ', & + expected(i)%aqso4_o3(j) + passed = .false. + end if + end do + end do + + end function compare_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function check_close(a, b, relative_tolerance, absolute_tolerance) + + real(r8), intent(in) :: a, b + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + real(r8) :: l_rel_tol = 1.0e-13_r8 + real(r8) :: l_abs_tol = 0.0_r8 + + if (present(relative_tolerance)) l_rel_tol = relative_tolerance + if (present(absolute_tolerance)) l_abs_tol = absolute_tolerance + check_close = abs(a - b) <= & + (abs(a) + abs(b))/2.0_r8 * l_rel_tol + l_abs_tol + + end function check_close + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module test_cloud_aqueous_chemistry_mod + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program test_cloud_aqueous_chemistry + + use test_cloud_aqueous_chemistry_mod, only: & + test_as_primary_rank_against_snapshot, & + test_as_other_rank_against_snapshot, & + test_as_primary_against_original_module, & + test_as_other_rank_against_original_module + + !call test_as_primary_rank_against_snapshot() + !call test_as_other_rank_against_snapshot() + call test_as_primary_against_original_module() + call test_as_other_rank_against_original_module() + +end program test_cloud_aqueous_chemistry + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \ No newline at end of file diff --git a/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_MAM.F90 b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_MAM.F90 new file mode 100644 index 0000000000..66033bf166 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_MAM.F90 @@ -0,0 +1,796 @@ +module test_cloud_aqueous_chemistry_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + integer, parameter :: n_ranks = 29 + integer, parameter :: n_timesteps = 1 + integer, parameter :: n_lat = 19 + integer, parameter :: n_lon = 24 + integer, parameter :: n_columns_per_rank = 16 + integer, parameter :: n_layers = 32 + integer, parameter :: n_invariants = 7 + integer, parameter :: n_species = 26 + integer, parameter :: n_modes = 4 + + character(len=*), parameter :: data_file = & + '../test/chemistry/data/QPC6-f10_f10_mg37.cam.h1i.0001-01-05-00000.nc' + + type :: chemistry_args + integer :: ncol + integer :: lchnk + integer :: loffset + real(r8) :: dtime + real(r8) :: time + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8), allocatable :: pres(:,:) + real(r8), allocatable :: pdel(:,:) + real(r8), allocatable :: tfld(:,:) + real(r8), allocatable :: mbar(:,:) + real(r8), allocatable :: lwc(:,:) + real(r8), allocatable :: cldfrc(:,:) + real(r8), allocatable :: cldnum(:,:) + real(r8), allocatable :: xhnm(:,:) + real(r8), allocatable :: invariants(:,:,:) + real(r8), allocatable :: qcw(:,:,:) + real(r8), allocatable :: qin(:,:,:) + real(r8), allocatable :: xphlwc(:,:) + real(r8), allocatable :: aqso4(:,:) + real(r8), allocatable :: aqh2so4(:,:) + real(r8), allocatable :: aqso4_h2o2(:) + real(r8), allocatable :: aqso4_o3(:) + end type chemistry_args + + interface read_and_condense_columns + module procedure read_and_condense_columns_2D + module procedure read_and_condense_columns_1D + end interface read_and_condense_columns + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .true. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Primary rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_primary_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_snapshot() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: sox_inti => initialize, & + setsox => calculate + + type(chemistry_args), allocatable :: chem_args(:), expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + chem_args = get_inputs() + expected_outputs = get_expected_outputs() + call sox_inti() + do i = 1, size(chem_args) + call setsox( & + state, & + pbuf, & + chem_args(i)%ncol, & + chem_args(i)%lchnk, & + chem_args(i)%loffset, & + chem_args(i)%dtime, & + chem_args(i)%pres, & + chem_args(i)%pdel, & + chem_args(i)%tfld, & + chem_args(i)%mbar, & + chem_args(i)%lwc, & + chem_args(i)%cldfrc, & + chem_args(i)%cldnum, & + chem_args(i)%xhnm, & + chem_args(i)%invariants, & + chem_args(i)%qcw, & + chem_args(i)%qin, & + chem_args(i)%xphlwc, & + chem_args(i)%aqso4, & + chem_args(i)%aqh2so4, & + chem_args(i)%aqso4_h2o2, & + chem_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(chem_args, expected_outputs, & + 1.0e-6_r8, 1.0e-40_r8)) then + write(*,*) 'Other rank test against snapshot failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_snapshot + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(new_args, old_args)) then + write(*,*) 'Primary rank test against original module failed' + stop 3 + end if + + end subroutine test_as_primary_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(new_args, old_args)) then + write(*,*) 'Other rank test against original module failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_inputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + type(file_io_t), pointer :: file + + integer :: i, j, i_time, i_lat, i_lon + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:), lats(:), lons(:) + + call initialize_args(chem_args) + file => file_io_t(data_file) + + allocate(temp1d(1)) + call file%read('time', temp1d) + do i = 1, size(chem_args) + chem_args(i)%time = temp1d(1) + end do + allocate(lats(n_lat)) + allocate(lons(n_lon)) + call file%read('lat', lats) + call file%read('lon', lons) + i = 1 + j = 0 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + j = j+1 + if (j>n_columns_per_rank) then + i = i + 1 + j = 1 + end if + chem_args(i)%lat(j) = lats(i_lat) + chem_args(i)%lon(j) = lons(i_lon) + end do + end do + end do + call read_and_condense_columns(file, 'cloud_press_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pres = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_pdel_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pdel = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_tfld_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%tfld = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_mbar_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%mbar = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_lwc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%lwc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldfrc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldfrc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldnum_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldnum = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_xhnm_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xhnm = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_invariants + write(index_string, '(I2)') j + call read_and_condense_columns(file, 'cloud_invariants_'// & + trim(adjustl(index_string))//'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%invariants(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do j = 1, n_species + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do i = 1, size(chem_args) + chem_args(i)%xphlwc = -1.0e300_r8 + chem_args(i)%aqso4 = -1.0e300_r8 + chem_args(i)%aqh2so4 = -1.0e300_r8 + chem_args(i)%aqso4_h2o2 = -1.0e300_r8 + chem_args(i)%aqso4_o3 = -1.0e300_r8 + end do + deallocate(file) + + end function get_inputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_expected_outputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + + type(file_io_t), pointer :: file + integer :: i, j + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:) + + chem_args = get_inputs() + file => file_io_t(data_file) + do j = 1, n_species + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + call read_and_condense_columns(file, 'cloud_xphlwc_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xphlwc(:,:) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_modes + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, & + 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqh2so4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + end do + call read_and_condense_columns(file, 'cloud_aqso4_h2o2_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_h2o2(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, 'cloud_aqso4_o3_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_o3(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + deallocate(file) + + end function get_expected_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine initialize_args(chem_args) + + type(chemistry_args), allocatable, intent(inout) :: chem_args(:) + + integer :: i + + if (allocated(chem_args)) deallocate(chem_args) + allocate(chem_args(n_ranks)) + do i = 1, size(chem_args) + chem_args(i)%ncol = min(n_columns_per_rank, n_lat*n_lon - & + (i-1)*n_columns_per_rank) + chem_args(i)%lchnk = 11 + chem_args(i)%loffset = 9 + chem_args(i)%dtime = 1800.0_r8 + allocate(chem_args(i)%lat(chem_args(i)%ncol)) + allocate(chem_args(i)%lon(chem_args(i)%ncol)) + allocate(chem_args(i)%pres(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%pdel(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%tfld(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%mbar(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%lwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldfrc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldnum(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%xhnm(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%invariants(chem_args(i)%ncol, n_layers, & + n_invariants)) + allocate(chem_args(i)%qcw(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%qin(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%xphlwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%aqso4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqh2so4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqso4_h2o2(chem_args(i)%ncol)) + allocate(chem_args(i)%aqso4_o3(chem_args(i)%ncol)) + end do + + end subroutine initialize_args + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_2D(file, variable_name, data, dim2) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:), allocatable, intent(inout) :: data + integer, intent(in) :: dim2 + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps, dim2)) + allocate(temp(n_lon, n_lat, dim2, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col,:) = temp(i_lon,i_lat,:,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_2D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_1D(file, variable_name, data) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:), allocatable, intent(inout) :: data + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps)) + allocate(temp(n_lon, n_lat, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col) = temp(i_lon,i_lat,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_1D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function compare_outputs(calculated, expected, relative_tolerance, & + absolute_tolerance) result(passed) + + type(chemistry_args), intent(in) :: calculated(:) + type(chemistry_args), intent(in) :: expected(:) + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + integer :: i, j, k, l + passed = .true. + + do i = 1, size(calculated) + do j = 1, calculated(i)%ncol + do k = 1, n_layers + if (.not. check_close(calculated(i)%pres(j,k), & + expected(i)%pres(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pres mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pres(j,k), ' expected: ', & + expected(i)%pres(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%pdel(j,k), & + expected(i)%pdel(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pdel mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pdel(j,k), ' expected: ', & + expected(i)%pdel(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%tfld(j,k), & + expected(i)%tfld(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'tfld mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%tfld(j,k), ' expected: ', & + expected(i)%tfld(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%mbar(j,k), & + expected(i)%mbar(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'mbar mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%mbar(j,k), ' expected: ', & + expected(i)%mbar(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%lwc(j,k), & + expected(i)%lwc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'lwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%lwc(j,k), ' expected: ', & + expected(i)%lwc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldfrc(j,k), & + expected(i)%cldfrc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldfrc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldfrc(j,k), ' expected: ', & + expected(i)%cldfrc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldnum(j,k), & + expected(i)%cldnum(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldnum mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldnum(j,k), ' expected: ', & + expected(i)%cldnum(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%xhnm(j,k), & + expected(i)%xhnm(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'xhnm mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xhnm(j,k), ' expected: ', & + expected(i)%xhnm(j,k) + passed = .false. + end if + do l = 1, n_invariants + if (.not. check_close(calculated(i)%invariants(j,k,l), & + expected(i)%invariants(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'invariants mismatch at column ', (i-1)*j, ' and layer ', & + k, ' and invariant ', l, ' calculated: ', & + calculated(i)%invariants(j,k,l), ' expected: ', & + expected(i)%invariants(j,k,l) + passed = .false. + end if + end do + do l = 1, n_species + if (.not. check_close(calculated(i)%qcw(j,k,l), & + expected(i)%qcw(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qcw mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qcw(j,k,l), & + ' expected: ', expected(i)%qcw(j,k,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%qin(j,k,l), & + expected(i)%qin(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qin mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qin(j,k,l), & + ' expected: ', expected(i)%qin(j,k,l) + passed = .false. + end if + end do + if (.not. check_close(calculated(i)%xphlwc(j,k), & + expected(i)%xphlwc(j,k), relative_tolerance, & + absolute_tolerance)) then + print *, 'xphlwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xphlwc(j,k), ' expected: ', & + expected(i)%xphlwc(j,k) + passed = .false. + end if + do l = 1, n_modes-1 ! the last mode is not actually set in the origical code + if (.not. check_close(calculated(i)%aqso4(j,l), & + expected(i)%aqso4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4 mismatch at column ', (i-1)*j, ' and mode ', l, & + ' calculated: ', calculated(i)%aqso4(j,l), ' expected: ', & + expected(i)%aqso4(j,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqh2so4(j,l), & + expected(i)%aqh2so4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqh2so4 mismatch at column ', (i-1)*j, ' and mode ', & + l, ' calculated: ', calculated(i)%aqh2so4(j,l), ' expected: ',& + expected(i)%aqh2so4(j,l) + passed = .false. + end if + end do + end do + if (.not. check_close(calculated(i)%aqso4_h2o2(j), & + expected(i)%aqso4_h2o2(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_h2o2 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_h2o2(j), ' expected: ', & + expected(i)%aqso4_h2o2(j) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqso4_o3(j), & + expected(i)%aqso4_o3(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_o3 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_o3(j), ' expected: ', & + expected(i)%aqso4_o3(j) + passed = .false. + end if + end do + end do + + end function compare_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function check_close(a, b, relative_tolerance, absolute_tolerance) + + real(r8), intent(in) :: a, b + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + real(r8) :: l_rel_tol = 1.0e-13_r8 + real(r8) :: l_abs_tol = 0.0_r8 + + if (present(relative_tolerance)) l_rel_tol = relative_tolerance + if (present(absolute_tolerance)) l_abs_tol = absolute_tolerance + check_close = abs(a - b) <= & + (abs(a) + abs(b))/2.0_r8 * l_rel_tol + l_abs_tol + + end function check_close + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module test_cloud_aqueous_chemistry_mod + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program test_cloud_aqueous_chemistry + + use test_cloud_aqueous_chemistry_mod, only: & + test_as_primary_rank_against_snapshot, & + test_as_other_rank_against_snapshot, & + test_as_primary_against_original_module, & + test_as_other_rank_against_original_module + + call test_as_primary_rank_against_snapshot() + call test_as_other_rank_against_snapshot() + call test_as_primary_against_original_module() + call test_as_other_rank_against_original_module() + +end program test_cloud_aqueous_chemistry + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \ No newline at end of file diff --git a/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_full.F90 b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_full.F90 new file mode 100644 index 0000000000..48b8a1ea23 --- /dev/null +++ b/test/chemistry/cloud_aqueous_chemistry/test_cloud_aqueous_chemistry_full.F90 @@ -0,0 +1,703 @@ +!> This test is based on the snapshot files, but adds randomly +!! generated data for species that are not present in the +!! configuration used to generate the snapshos file. +!! +!! We don't check against the output data in the snapshot file, but +!! we do run against the original code with the same randomly +!! generated data. +module test_cloud_aqueous_chemistry_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use chemistry_test_data + + implicit none + + integer, parameter :: n_ranks = 29 + integer, parameter :: n_timesteps = 1 + integer, parameter :: n_lat = 19 + integer, parameter :: n_lon = 24 + integer, parameter :: n_columns_per_rank = 16 + integer, parameter :: n_layers = 32 + integer, parameter :: n_invariants = 7 + integer, parameter :: n_species = 26 + integer, parameter :: n_modes = 4 + + character(len=*), parameter :: data_file = & + '../test/chemistry/data/QPC6-f10_f10_mg37.cam.h1i.0001-01-05-00000.nc' + + type :: chemistry_args + integer :: ncol + integer :: lchnk + integer :: loffset + real(r8) :: dtime + real(r8) :: time + real(r8), allocatable :: lat(:) + real(r8), allocatable :: lon(:) + real(r8), allocatable :: pres(:,:) + real(r8), allocatable :: pdel(:,:) + real(r8), allocatable :: tfld(:,:) + real(r8), allocatable :: mbar(:,:) + real(r8), allocatable :: lwc(:,:) + real(r8), allocatable :: cldfrc(:,:) + real(r8), allocatable :: cldnum(:,:) + real(r8), allocatable :: xhnm(:,:) + real(r8), allocatable :: invariants(:,:,:) + real(r8), allocatable :: qcw(:,:,:) + real(r8), allocatable :: qin(:,:,:) + real(r8), allocatable :: xphlwc(:,:) + real(r8), allocatable :: aqso4(:,:) + real(r8), allocatable :: aqh2so4(:,:) + real(r8), allocatable :: aqso4_h2o2(:) + real(r8), allocatable :: aqso4_o3(:) + end type chemistry_args + + interface read_and_condense_columns + module procedure read_and_condense_columns_2D + module procedure read_and_condense_columns_1D + end interface read_and_condense_columns + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_primary_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + do_debug_logging = i == 4 + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + do_debug_logging = i == 4 + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(new_args, old_args)) then + write(*,*) 'Primary rank test against original module failed' + stop 3 + end if + + end subroutine test_as_primary_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_as_other_rank_against_original_module() + + use spmd_utils, only: masterproc + use physics_buffer, only: physics_buffer_desc + use physics_types, only: physics_state + use cloud_aqueous_chemistry, only: new_sox_inti => initialize, & + new_setsox => calculate + use mo_setsox, only: old_sox_inti => sox_inti, old_setsox => setsox + + type(chemistry_args), allocatable :: new_args(:), old_args(:) + type(chemistry_args), allocatable :: expected_outputs(:) + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state) :: state + integer :: i + + allocate(pbuf(n_columns_per_rank)) + masterproc = .false. + new_args = get_inputs() + old_args = get_inputs() + expected_outputs = get_expected_outputs() + call new_sox_inti() + call old_sox_inti() + do i = 1, size(new_args) + call new_setsox( & + state, & + pbuf, & + new_args(i)%ncol, & + new_args(i)%lchnk, & + new_args(i)%loffset, & + new_args(i)%dtime, & + new_args(i)%pres, & + new_args(i)%pdel, & + new_args(i)%tfld, & + new_args(i)%mbar, & + new_args(i)%lwc, & + new_args(i)%cldfrc, & + new_args(i)%cldnum, & + new_args(i)%xhnm, & + new_args(i)%invariants, & + new_args(i)%qcw, & + new_args(i)%qin, & + new_args(i)%xphlwc, & + new_args(i)%aqso4, & + new_args(i)%aqh2so4, & + new_args(i)%aqso4_h2o2, & + new_args(i)%aqso4_o3 & + ) + end do + do i = 1, size(old_args) + call old_setsox( & + state, & + pbuf, & + old_args(i)%ncol, & + old_args(i)%lchnk, & + old_args(i)%loffset, & + old_args(i)%dtime, & + old_args(i)%pres, & + old_args(i)%pdel, & + old_args(i)%tfld, & + old_args(i)%mbar, & + old_args(i)%lwc, & + old_args(i)%cldfrc, & + old_args(i)%cldnum, & + old_args(i)%xhnm, & + old_args(i)%invariants, & + old_args(i)%qcw, & + old_args(i)%qin, & + old_args(i)%xphlwc, & + old_args(i)%aqso4, & + old_args(i)%aqh2so4, & + old_args(i)%aqso4_h2o2, & + old_args(i)%aqso4_o3 & + ) + end do + deallocate(pbuf) + if (.not. compare_outputs(new_args, old_args)) then + write(*,*) 'Other rank test against original module failed' + stop 3 + end if + + end subroutine test_as_other_rank_against_original_module + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_inputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + type(file_io_t), pointer :: file + + integer :: i, j, k, i_time, i_lat, i_lon + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:), lats(:), lons(:) + + call initialize_args(chem_args) + file => file_io_t(data_file) + + allocate(temp1d(1)) + call file%read('time', temp1d) + do i = 1, size(chem_args) + chem_args(i)%time = temp1d(1) + end do + allocate(lats(n_lat)) + allocate(lons(n_lon)) + call file%read('lat', lats) + call file%read('lon', lons) + i = 1 + j = 0 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + j = j+1 + if (j>n_columns_per_rank) then + i = i + 1 + j = 1 + end if + chem_args(i)%lat(j) = lats(i_lat) + chem_args(i)%lon(j) = lons(i_lon) + end do + end do + end do + call read_and_condense_columns(file, 'cloud_press_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pres = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_pdel_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%pdel = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_tfld_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%tfld = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_mbar_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%mbar = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_lwc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%lwc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldfrc_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldfrc = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_cldnum_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%cldnum = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, 'cloud_xhnm_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xhnm = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_invariants + write(index_string, '(I2)') j + call read_and_condense_columns(file, 'cloud_invariants_'// & + trim(adjustl(index_string))//'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%invariants(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + do j = 1, n_species + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string)) //'_in', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + ! Modify to include randomly generated data for species not included in the + ! configuration used to generate the snapshot file. + do i = 1, size(chem_args) + do j = 1, size(chem_args(i)%qin, dim=2) + do k = 1, size(chem_args(i)%qin, dim=3) + chem_args(i)%qin(j,k,1) = 25.0e-9_r8 + 1.0e-10_r8 * (i + j + k) ! NH3 ~ 25 ppb + chem_args(i)%qin(j,k,2) = 10.0e-9_r8 + 1.0e-10_r8 * (i + j + k) ! HNO3 ~ 10 ppb + chem_args(i)%qin(j,k,3) = 5.0e-10_r8 + 1.0e-11_r8 * (i + j + k) ! MSA ~ 0.5 ppb + end do + end do + end do + do i = 1, size(chem_args) + chem_args(i)%xphlwc = -1.0e300_r8 + chem_args(i)%aqso4 = -1.0e300_r8 + chem_args(i)%aqh2so4 = -1.0e300_r8 + chem_args(i)%aqso4_h2o2 = -1.0e300_r8 + chem_args(i)%aqso4_o3 = -1.0e300_r8 + end do + deallocate(file) + + end function get_inputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function get_expected_outputs() result(chem_args) + + use file_io, only: file_io_t + + type(chemistry_args), allocatable :: chem_args(:) + + type(file_io_t), pointer :: file + integer :: i, j + character(len=10) :: index_string + real(r8), allocatable :: temp1d(:), temp2d(:,:) + + chem_args = get_inputs() + file => file_io_t(data_file) + do j = 1, n_species + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_qcw_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qcw(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + call read_and_condense_columns(file, & + 'cloud_qin_'//trim(adjustl(index_string))//'_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%qin(:,:,j) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + end do + call read_and_condense_columns(file, 'cloud_xphlwc_out', temp2d, n_layers) + do i = 1, size(chem_args) + chem_args(i)%xphlwc(:,:) = temp2d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp2d, dim=1)),:) + end do + do j = 1, n_modes + write(index_string, '(I2)') j + call read_and_condense_columns(file, & + 'cloud_aqso4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, & + 'cloud_aqh2so4_'//trim(adjustl(index_string))//'_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqh2so4(:,j) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + end do + call read_and_condense_columns(file, 'cloud_aqso4_h2o2_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_h2o2(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + call read_and_condense_columns(file, 'cloud_aqso4_o3_out', temp1d) + do i = 1, size(chem_args) + chem_args(i)%aqso4_o3(:) = temp1d((i-1)*n_columns_per_rank+1 & + : min(i*n_columns_per_rank,size(temp1d))) + end do + deallocate(file) + + end function get_expected_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine initialize_args(chem_args) + + type(chemistry_args), allocatable, intent(inout) :: chem_args(:) + + integer :: i + + if (allocated(chem_args)) deallocate(chem_args) + allocate(chem_args(n_ranks)) + do i = 1, size(chem_args) + chem_args(i)%ncol = min(n_columns_per_rank, n_lat*n_lon - & + (i-1)*n_columns_per_rank) + chem_args(i)%lchnk = 11 + chem_args(i)%loffset = 9 + chem_args(i)%dtime = 1800.0_r8 + allocate(chem_args(i)%lat(chem_args(i)%ncol)) + allocate(chem_args(i)%lon(chem_args(i)%ncol)) + allocate(chem_args(i)%pres(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%pdel(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%tfld(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%mbar(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%lwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldfrc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%cldnum(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%xhnm(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%invariants(chem_args(i)%ncol, n_layers, & + n_invariants)) + allocate(chem_args(i)%qcw(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%qin(chem_args(i)%ncol, n_layers, n_species)) + allocate(chem_args(i)%xphlwc(chem_args(i)%ncol, n_layers)) + allocate(chem_args(i)%aqso4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqh2so4(chem_args(i)%ncol, n_modes)) + allocate(chem_args(i)%aqso4_h2o2(chem_args(i)%ncol)) + allocate(chem_args(i)%aqso4_o3(chem_args(i)%ncol)) + end do + + end subroutine initialize_args + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_2D(file, variable_name, data, dim2) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:), allocatable, intent(inout) :: data + integer, intent(in) :: dim2 + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps, dim2)) + allocate(temp(n_lon, n_lat, dim2, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col,:) = temp(i_lon,i_lat,:,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_2D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_and_condense_columns_1D(file, variable_name, data) + + use file_io, only: file_io_t + + type(file_io_t), intent(in) :: file + character(len=*), intent(in) :: variable_name + real(r8), dimension(:), allocatable, intent(inout) :: data + + integer :: i_time, i_lat, i_lon, i_col + real(r8), allocatable :: temp(:,:,:) + + if (allocated(data)) deallocate(data) + allocate(data(n_lat*n_lon*n_timesteps)) + allocate(temp(n_lon, n_lat, n_timesteps)) + call file%read(variable_name, temp) + i_col = 1 + do i_time = 1, n_timesteps + do i_lat = 1, n_lat + do i_lon = 1, n_lon + data(i_col) = temp(i_lon,i_lat,i_time) + i_col = i_col + 1 + end do + end do + end do + + end subroutine read_and_condense_columns_1D + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function compare_outputs(calculated, expected, relative_tolerance, & + absolute_tolerance) result(passed) + + type(chemistry_args), intent(in) :: calculated(:) + type(chemistry_args), intent(in) :: expected(:) + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + integer :: i, j, k, l + passed = .true. + + do i = 1, size(calculated) + do j = 1, calculated(i)%ncol + do k = 1, n_layers + if (.not. check_close(calculated(i)%pres(j,k), & + expected(i)%pres(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pres mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pres(j,k), ' expected: ', & + expected(i)%pres(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%pdel(j,k), & + expected(i)%pdel(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'pdel mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%pdel(j,k), ' expected: ', & + expected(i)%pdel(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%tfld(j,k), & + expected(i)%tfld(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'tfld mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%tfld(j,k), ' expected: ', & + expected(i)%tfld(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%mbar(j,k), & + expected(i)%mbar(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'mbar mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%mbar(j,k), ' expected: ', & + expected(i)%mbar(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%lwc(j,k), & + expected(i)%lwc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'lwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%lwc(j,k), ' expected: ', & + expected(i)%lwc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldfrc(j,k), & + expected(i)%cldfrc(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldfrc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldfrc(j,k), ' expected: ', & + expected(i)%cldfrc(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%cldnum(j,k), & + expected(i)%cldnum(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'cldnum mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%cldnum(j,k), ' expected: ', & + expected(i)%cldnum(j,k) + passed = .false. + end if + if (.not. check_close(calculated(i)%xhnm(j,k), & + expected(i)%xhnm(j,k), relative_tolerance, absolute_tolerance)) then + print *, 'xhnm mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xhnm(j,k), ' expected: ', & + expected(i)%xhnm(j,k) + passed = .false. + end if + do l = 1, n_invariants + if (.not. check_close(calculated(i)%invariants(j,k,l), & + expected(i)%invariants(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'invariants mismatch at column ', (i-1)*j, ' and layer ', & + k, ' and invariant ', l, ' calculated: ', & + calculated(i)%invariants(j,k,l), ' expected: ', & + expected(i)%invariants(j,k,l) + passed = .false. + end if + end do + do l = 1, n_species + if (.not. check_close(calculated(i)%qcw(j,k,l), & + expected(i)%qcw(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qcw mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qcw(j,k,l), & + ' expected: ', expected(i)%qcw(j,k,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%qin(j,k,l), & + expected(i)%qin(j,k,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'qin mismatch at column ', (i-1)*j, ' and layer ', k, & + ' and species ', l, ' calculated: ', calculated(i)%qin(j,k,l), & + ' expected: ', expected(i)%qin(j,k,l), i, j, k, l + passed = .false. + end if + end do + if (.not. check_close(calculated(i)%xphlwc(j,k), & + expected(i)%xphlwc(j,k), relative_tolerance, & + absolute_tolerance)) then + print *, 'xphlwc mismatch at column ', (i-1)*j, ' and layer ', k, & + ' calculated: ', calculated(i)%xphlwc(j,k), ' expected: ', & + expected(i)%xphlwc(j,k) + passed = .false. + end if + do l = 1, n_modes-1 ! the last mode is not actually set in the origical code + if (.not. check_close(calculated(i)%aqso4(j,l), & + expected(i)%aqso4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4 mismatch at column ', (i-1)*j, ' and mode ', l, & + ' calculated: ', calculated(i)%aqso4(j,l), ' expected: ', & + expected(i)%aqso4(j,l) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqh2so4(j,l), & + expected(i)%aqh2so4(j,l), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqh2so4 mismatch at column ', (i-1)*j, ' and mode ', & + l, ' calculated: ', calculated(i)%aqh2so4(j,l), ' expected: ',& + expected(i)%aqh2so4(j,l) + passed = .false. + end if + end do + end do + if (.not. check_close(calculated(i)%aqso4_h2o2(j), & + expected(i)%aqso4_h2o2(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_h2o2 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_h2o2(j), ' expected: ', & + expected(i)%aqso4_h2o2(j) + passed = .false. + end if + if (.not. check_close(calculated(i)%aqso4_o3(j), & + expected(i)%aqso4_o3(j), relative_tolerance, & + absolute_tolerance)) then + print *, 'aqso4_o3 mismatch at column ', (i-1)*j, & + ' calculated: ', calculated(i)%aqso4_o3(j), ' expected: ', & + expected(i)%aqso4_o3(j) + passed = .false. + end if + end do + end do + + end function compare_outputs + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function check_close(a, b, relative_tolerance, absolute_tolerance) + + real(r8), intent(in) :: a, b + real(r8), optional, intent(in) :: relative_tolerance + real(r8), optional, intent(in) :: absolute_tolerance + + real(r8) :: l_rel_tol = 1.0e-13_r8 + real(r8) :: l_abs_tol = 0.0_r8 + + if (present(relative_tolerance)) l_rel_tol = relative_tolerance + if (present(absolute_tolerance)) l_abs_tol = absolute_tolerance + check_close = abs(a - b) <= & + (abs(a) + abs(b))/2.0_r8 * l_rel_tol + l_abs_tol + + end function check_close + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module test_cloud_aqueous_chemistry_mod + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +program test_cloud_aqueous_chemistry_full + + use test_cloud_aqueous_chemistry_mod, only: & + test_as_primary_against_original_module, & + test_as_other_rank_against_original_module + + call test_as_primary_against_original_module() + call test_as_other_rank_against_original_module() + +end program test_cloud_aqueous_chemistry_full + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \ No newline at end of file diff --git a/test/chemistry/cmake/dependencies.cmake b/test/chemistry/cmake/dependencies.cmake new file mode 100644 index 0000000000..7d8f2f3536 --- /dev/null +++ b/test/chemistry/cmake/dependencies.cmake @@ -0,0 +1,30 @@ +find_package(PkgConfig REQUIRED) +include(FetchContent) + +# ############################################################################## +# Memory check + +if(CAMCHEM_ENABLE_MEMCHECK) + find_file( + MEMCHECK_SUPPRESS_FILE + DOC "Suppression file for memory checking" + NAMES openmpi-valgrind.supp + PATHS /usr/share/openmpi /usr/lib64/openmpi/share + /usr/lib64/openmpi/share/openmpi /usr/share) + if(MEMCHECK_SUPPRESS_FILE) + set(MEMCHECK_SUPPRESS + "--suppressions=${PROJECT_SOURCE_DIR}/valgrind.supp --suppressions=${MEMCHECK_SUPPRESS_FILE}" + ) + else() + set(MEMCHECK_SUPPRESS + "--suppressions=${PROJECT_SOURCE_DIR}/valgrind.supp") + endif() +endif() + +# ############################################################################## +# NetCDF library + +find_package(PkgConfig REQUIRED) + +pkg_check_modules(netcdff IMPORTED_TARGET REQUIRED netcdf-fortran) +pkg_check_modules(netcdfc IMPORTED_TARGET REQUIRED netcdf) diff --git a/test/chemistry/cmake/test_util.cmake b/test/chemistry/cmake/test_util.cmake new file mode 100644 index 0000000000..177363abec --- /dev/null +++ b/test/chemistry/cmake/test_util.cmake @@ -0,0 +1,57 @@ +################################################################################ +# Utility functions for creating tests + +if(CAMCHEM_ENABLE_MEMCHECK) + find_program(MEMORYCHECK_COMMAND "valgrind") +endif() + +################################################################################ +# build and add a standard test + +function(create_standard_test) + set(prefix TEST) + set(singleValues NAME WORKING_DIRECTORY) + set(multiValues SOURCES CPP_FLAGS) + include(CMakeParseArguments) + cmake_parse_arguments(${prefix} " " "${singleValues}" "${multiValues}" ${ARGN}) + add_executable(test_${TEST_NAME} ${TEST_SOURCES}) + if(TEST_CPP_FLAGS) + target_compile_options(test_${TEST_NAME} PRIVATE ${TEST_CPP_FLAGS}) + endif() + set_target_properties(test_${TEST_NAME} PROPERTIES LINKER_LANGUAGE Fortran) + target_link_libraries(test_${TEST_NAME} PRIVATE PkgConfig::netcdff PkgConfig::netcdfc) + if(CAMCHEM_ENABLE_OPENMP) + target_link_libraries(test_${TEST_NAME} PUBLIC OpenMP::OpenMP_Fortran) + endif() + if(NOT DEFINED TEST_WORKING_DIRECTORY) + set(TEST_WORKING_DIRECTORY "${CMAKE_BINARY_DIR}") + endif() + add_camchem_test(${TEST_NAME} test_${TEST_NAME} "" ${TEST_WORKING_DIRECTORY}) +endfunction(create_standard_test) + +################################################################################ +# Add a test + +function(add_camchem_test test_name test_binary test_args working_dir) + if(CAMCHEM_ENABLE_MPI) + add_test(NAME ${test_name} + COMMAND mpirun -v -np 2 ${CMAKE_BINARY_DIR}/${test_binary} ${test_args} + WORKING_DIRECTORY ${working_dir}) + else() + add_test(NAME ${test_name} + COMMAND ${test_binary} ${test_args} + WORKING_DIRECTORY ${working_dir}) + endif() + set(MEMORYCHECK_COMMAND_OPTIONS "--error-exitcode=1 --trace-children=yes --leak-check=full -s --gen-suppressions=all ${MEMCHECK_SUPPRESS}") + set(memcheck "${MEMORYCHECK_COMMAND} ${MEMORYCHECK_COMMAND_OPTIONS}") + separate_arguments(memcheck) + if(CAMCHEM_ENABLE_MPI AND MEMORYCHECK_COMMAND AND CAMCHEM_ENABLE_MEMCHECK) + add_test(NAME memcheck_${test_name} + COMMAND mpirun -v -np 2 ${memcheck} ${CMAKE_BINARY_DIR}/${test_binary} ${test_args} + WORKING_DIRECTORY ${working_dir}) + elseif(MEMORYCHECK_COMMAND AND CAMCHEM_ENABLE_MEMCHECK) + add_test(NAME memcheck_${test_name} + COMMAND ${memcheck} ${working_dir}/${test_binary} ${test_args} + WORKING_DIRECTORY ${working_dir}) + endif() +endfunction(add_camchem_test) \ No newline at end of file diff --git a/test/chemistry/data/QPC6-f10_f10_mg37.cam.h1i.0001-01-05-00000.nc b/test/chemistry/data/QPC6-f10_f10_mg37.cam.h1i.0001-01-05-00000.nc new file mode 100644 index 0000000000..6081ef8725 Binary files /dev/null and b/test/chemistry/data/QPC6-f10_f10_mg37.cam.h1i.0001-01-05-00000.nc differ diff --git a/test/chemistry/data/QPCARMATS-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc b/test/chemistry/data/QPCARMATS-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc new file mode 100644 index 0000000000..789228d468 Binary files /dev/null and b/test/chemistry/data/QPCARMATS-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc differ diff --git a/test/chemistry/data/QPMOZ-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc b/test/chemistry/data/QPMOZ-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc new file mode 100644 index 0000000000..2b34f2c3a7 Binary files /dev/null and b/test/chemistry/data/QPMOZ-f10_f10_mg37-cloud-chemistry-mod.cam.h1i.0001-01-01-05400.nc differ diff --git a/test/chemistry/file_io.F90 b/test/chemistry/file_io.F90 new file mode 100644 index 0000000000..6035fe5119 --- /dev/null +++ b/test/chemistry/file_io.F90 @@ -0,0 +1,279 @@ +module file_io + +#define CHECK_STATUS(status, msg) call check_status(status, msg, __FILE__, __LINE__) + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: file_io_t + + integer, parameter :: kUnknownFileId = -9999 + + type :: file_io_t + character(len=:), allocatable :: path_ + integer :: id_ = kUnknownFileId + contains + procedure :: read_1D_int + procedure :: read_1D_real + procedure :: read_2D_int + procedure :: read_2D_real + procedure :: read_3D_int + procedure :: read_3D_real + procedure :: read_4D_int + procedure :: read_4D_real + generic :: read => read_1D_int, read_1D_real, read_2D_int, read_2D_real, & + read_3D_int, read_3D_real, read_4D_int, read_4D_real + final :: finalize + end type file_io_t + + interface file_io_t + procedure :: constructor + end interface file_io_t + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + function constructor(path, do_log) result(self) + + use netcdf, only : nf90_open, nf90_inquire, nf90_inquire_dimension, & + nf90_inquire_variable, NF90_NOWRITE, NF90_MAX_NAME + + character(len=*), intent(in) :: path + logical, intent(in), optional :: do_log + + type(file_io_t), pointer :: self + integer :: nvars, ndims, varid, dimids(10) + integer, allocatable :: dims(:) + character(len=NF90_MAX_NAME) :: varname + integer :: i + + allocate(self) + + self%path_ = path + self%id_ = 0 + + CHECK_STATUS(nf90_open(self%path_, NF90_NOWRITE, self%id_), \ + "Error opening file: "//trim(self%path_)) + if (present(do_log)) then + if (do_log) then + write(*,*) "Opened file: ", trim(self%path_) + + ! Get the number of variables and dimensions in the file + CHECK_STATUS(nf90_inquire(self%id_, nVariables=nvars), \ + "Error inquiring number of variables") + CHECK_STATUS(nf90_inquire(self%id_, nDimensions=ndims), \ + "Error inquiring number of dimensions") + + allocate(dims(ndims)) + do i = 1, ndims + CHECK_STATUS(nf90_inquire_dimension(self%id_, i, len=dims(i)), \ + "Error inquiring dimension length") + end do + + ! Loop over all variables and print their names and dimensions + do i = 1, nvars + CHECK_STATUS(nf90_inquire_variable(self%id_, i, name=varname, \ + ndims=ndims, dimids=dimids), \ + "Error inquiring variable") + write(*,*) "Variable: ", trim(varname), " Dimensions: ", dims(dimids(1:ndims)) + end do + end if + end if + + end function constructor + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_1D_int(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + integer, dimension(:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_1D_int + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_1D_real(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + real(r8), dimension(:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_1D_real + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_2D_int(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + integer, dimension(:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_2D_int + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_2D_real(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_2D_real + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_3D_int(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + integer, dimension(:,:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_3D_int + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_3D_real(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_3D_real + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_4D_int(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + integer, dimension(:,:,:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_4D_int + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine read_4D_real(self, variable_name, data) + + use netcdf, only : nf90_inq_varid, nf90_get_var + + class(file_io_t), intent(in) :: self + character(len=*), intent(in) :: variable_name + real(r8), dimension(:,:,:,:), intent(out) :: data + + integer :: var_id + + CHECK_STATUS(nf90_inq_varid(self%id_, trim(variable_name), var_id), \ + "Error getting variable id: '"//trim(variable_name)//"'") + CHECK_STATUS(nf90_get_var(self%id_, var_id, data), \ + "Error reading variable: '"//trim(variable_name)//"'") + + end subroutine read_4D_real + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine finalize(self) + + use netcdf, only : nf90_close + + type(file_io_t), intent(inout) :: self + + if (self%id_ .ne. kUnknownFileId) then + CHECK_STATUS(nf90_close(self%id_), \ + "Error closing file: "//trim(self%path_)) + self%id_ = kUnknownFileId + end if + if (allocated(self%path_)) deallocate(self%path_) + + end subroutine finalize + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine check_status(status, msg, file, line) + + use netcdf, only : nf90_strerror, NF90_NOERR + + integer, intent(in) :: status + character(len=*), intent(in) :: msg + character(len=*), intent(in) :: file + integer, intent(in) :: line + + if (status /= NF90_NOERR) then + write(*,*) "Error: ", trim( nf90_strerror(status) ), " - ", trim(msg) + write(*,*) "File: ", file + write(*,*) "Line: ", line + stop 3 + end if + + end subroutine check_status + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module file_io \ No newline at end of file diff --git a/test/chemistry/valgrind.supp b/test/chemistry/valgrind.supp new file mode 100644 index 0000000000..e69de29bb2