From 2deed9efd91860ebe281706a802b06a7dd739130 Mon Sep 17 00:00:00 2001 From: manderberg Date: Mon, 18 Jul 2022 11:58:17 -0600 Subject: [PATCH 01/14] committing changes toward running caram_dust with SE Dycode --- src/physics/carma/cam/carma_intr.F90 | 38 ++++----- .../carma/models/dust/carma_model_mod.F90 | 83 +++++++++---------- 2 files changed, 55 insertions(+), 66 deletions(-) diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 50bad3dffa..fabfb467ac 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -1105,13 +1105,13 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! Assume resolution is 64x128. if (single_column) then - dx = 360._r8 / 128._r8 - dy = 180._r8 / 64._r8 +! dx = 360._r8 / 128._r8 +! dy = 180._r8 / 64._r8 else ! Calculate the x and y coordinates, in degrees latitude and longitude. - dx = 360._r8 / plon - dy = 180._r8 / (plat-1) +! dx = 360._r8 / plon +! dy = 180._r8 / (plat-1) end if call CARMASTATE_CreateFromReference(cstate, & @@ -1148,30 +1148,30 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli yc(:) = state_loc%lat(icol) / DEG2RAD ! Assume resolution is 64x128. - if (single_column) then - dx = 360._r8 / 128._r8 - dy = 180._r8 / 64._r8 - else +! if (single_column) then +! dx = 360._r8 / 128._r8 +! dy = 180._r8 / 64._r8 +! else ! Caclulate the x and y coordinates, in degrees latitude and longitude. - dx(:) = 360._r8 / plon +! dx(:) = 360._r8 / plon - dlat = 180._r8 / (plat-1) +! dlat = 180._r8 / (plat-1) ! The pole points need special treatment, since the point is not the ! center of the grid box. ! ! In single column mode there is just one latitude, so make it global. - if (abs(state_loc%lat(icol) / DEG2RAD) >= (90._r8 - (90._r8 / (plat-1)))) then +! if (abs(state_loc%lat(icol) / DEG2RAD) >= (90._r8 - (90._r8 / (plat-1)))) then ! Nudge yc toward the equator. - yc(:) = yc(:) - sign(0.25_r8,state_loc%lat(icol)) * dlat +! yc(:) = yc(:) - sign(0.25_r8,state_loc%lat(icol)) * dlat - dy(:) = dlat / 2._r8 - else - dy(:) = dlat - endif - end if +! dy(:) = dlat / 2._r8 +! else +! dy(:) = dlat +! endif +! end if if (is_first_step()) then t_ptr(icol,:) = state_loc%t(icol,:) @@ -2055,10 +2055,6 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ncol = state%ncol lchnk = state%lchnk - call get_lat_all_p(lchnk, ncol, lat) - call get_lon_all_p(lchnk, ncol, lon) - call get_rlat_all_p(lchnk, ncol, clat) - ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index cfd1d3f284..1d5bef3827 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -262,7 +262,6 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state - use phys_grid, only: get_lon_all_p, get_lat_all_p use camsrfexch, only: cam_in_t use cam_history, only: outfld @@ -298,8 +297,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8) :: wwd ! raw wind speed (m/s) real(r8) :: sp ! mass fraction for soil factor integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay - real(r8) :: soilfact(pcols) ! soil erosion factor (for debug) - + ! Default return code. rc = RC_OK @@ -307,9 +305,6 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend lchnk = state%lchnk ncol = state%ncol - call get_lat_all_p(lchnk, ncol, ilat) - call get_lon_all_p(lchnk, ncol, ilon) - ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 @@ -346,23 +341,21 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Process each column. do icol = 1,ncol - call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + call CARMA_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) ! Is the wind above the threshold for dust production? if (uv10 > uth) then - surfaceFlux(icol) = ch * soil_factor(ilat(icol), ilon(icol)) * sp * & + surfaceFlux(icol) = ch * soil_factor(icol, lchnk) * sp * & wwd * (uv10 - uth) endif ! Scale the clay bins based upon the smallest silt bin. surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) - ! Save off the soil erosion factor so it can be output. - soilfact(icol) = soil_factor(ilat(icol), ilon(icol)) end do ! For debug purposes, output the soil erosion factor. - call outfld('CRSLERFC', soilfact, pcols, lchnk) + call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) end if return @@ -380,10 +373,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) implicit none - type(carma_type), intent(in) :: carma !! the carma object - logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent + type(carma_type), intent(in) :: carma !! the carma object + logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency - integer, intent(out) :: rc !! return code, negative indicates failure + integer, intent(out) :: rc !! return code, negative indicates failure ! -------- local variables ---------- integer :: ibin ! CARMA bin index @@ -472,7 +465,7 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none @@ -627,7 +620,7 @@ end subroutine CARMA_ClayMassFraction !! !! @author Lin Su, Pengfei Yu, Chuck Bardeen !! @version July-2012 - subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -638,8 +631,6 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin type(carma_type), intent(in) :: carma !! the carma object type(physics_state), intent(in) :: state !! physics state integer, intent(in) :: icol !! column index - integer, intent(in) :: ilat !! latitude index - integer, intent(in) :: ilon !! longitude index integer, intent(in) :: ielem !! element index integer, intent(in) :: igroup !! group index integer, intent(in) :: ibin !! bin index @@ -702,10 +693,13 @@ end subroutine CARMA_SurfaceWind !! @author Pengfei Yu !! @version July-2012 subroutine CARMA_ReadSoilErosionFactor(carma, rc) - use pmgrid, only: plat, plon - use ioFileMod, only: getfil +! use physics_types, only: physics_state + use pmgrid, only: plat, plon + use ppgrid, only: begchunk, endchunk, pcols + use ioFileMod, only: getfil use wrap_nf - use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish + use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only: get_lon_all_p, get_lat_all_p, get_ncols_p implicit none @@ -715,13 +709,16 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) ! local variables integer :: idvar, f_nlon, f_nlat, idlat, idlon integer :: fid, fid_lon, fid_lat - real(r8), allocatable, dimension(:,:) :: ero_factor, ero_factor1 + real(r8), allocatable, dimension(:,:) :: ero_factor character(len=256) :: ero_file real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension type (interp_type) :: wgt1, wgt2 - real(r8) :: lat(plat), lon(plon) - integer :: i + real(r8) :: lat(pcols) ! latitude index + real(r8) :: lon(pcols) ! longitude index + integer :: i, ii + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk rc = RC_OK @@ -738,8 +735,8 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) allocate(ero_lat(f_nlat)) allocate(ero_lon(f_nlon)) allocate(ero_factor (f_nlon, f_nlat)) - allocate(ero_factor1(plon, plat)) - allocate(soil_factor(plat, plon)) + allocate(soil_factor(pcols, begchunk:endchunk)) + ! Read in the tables. call wrap_inq_varid(fid, 'new_source', idvar) @@ -756,29 +753,25 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) ! Close the file. call wrap_close(fid) - ! NOTE: Is there a better way to get all of the dimensions - ! needed for the model grid? Seems like it shouldn't be hard - ! coded here. - do i = 1, plat - lat(i) = 180._r8 / (plat-1) * (i-1) - 90._r8 - end do - - do i = 1, plon - lon(i) = 360._r8 / plon * (i-1) - end do - - call lininterp_init(ero_lat, f_nlat, lat, plat, 1, wgt1) - call lininterp_init(ero_lon, f_nlon, lon, plon, 1, wgt2) - call lininterp(ero_factor, f_nlon, f_nlat, ero_factor1, plon, plat, wgt2, wgt1) - call lininterp_finish(wgt1) - call lininterp_finish(wgt2) - - soil_factor(:plat, :plon) = transpose(ero_factor1(:plon, :plat)) + do lchnk=begchunk, endchunk + ncol = get_ncols_p(lchnk) + + call get_lat_all_p(lchnk, pcols, lat) + call get_lon_all_p(lchnk, pcols, lon) + + call lininterp_init(ero_lon, f_nlon, lon, ncol, 1, wgt2) + call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, wgt1) + + call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, wgt2, wgt1) + + call lininterp_finish(wgt1) + call lininterp_finish(wgt2) + end do deallocate(ero_lat) deallocate(ero_lon) deallocate(ero_factor) - deallocate(ero_factor1) + return end subroutine CARMA_ReadSoilErosionFactor From 43822634f7b15a9b9570289232d6d3b0d2bf895f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 4 Aug 2022 16:07:00 -0600 Subject: [PATCH 02/14] changes for unstructured grids modified: Externals_CAM.cfg modified: bld/namelist_files/namelist_defaults_cam.xml modified: cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam modified: cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam modified: cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam modified: cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam modified: src/physics/cam/physpkg.F90 modified: src/physics/carma/cam/carma_constants_mod.F90 modified: src/physics/carma/cam/carma_getH2O.F90 modified: src/physics/carma/cam/carma_getH2SO4.F90 modified: src/physics/carma/cam/carma_getT.F90 modified: src/physics/carma/cam/carma_intr.F90 modified: src/physics/carma/models/cirrus/carma_model_mod.F90 modified: src/physics/carma/models/dust/carma_model_mod.F90 modified: src/physics/carma/models/meteor_impact/carma_model_mod.F90 modified: src/physics/carma/models/sea_salt/carma_model_mod.F90 --- Externals_CAM.cfg | 5 +- bld/namelist_files/namelist_defaults_cam.xml | 1 + .../testmods_dirs/cam/carma_dust/user_nl_cam | 1 + .../cam/carma_meteor_impact/user_nl_cam | 5 +- .../cam/carma_mixed_sulfate/user_nl_cam | 4 +- .../testmods_dirs/cam/carma_pmc/user_nl_cam | 2 +- src/physics/carma/cam/carma_constants_mod.F90 | 87 +- src/physics/carma/cam/carma_getH2O.F90 | 40 +- src/physics/carma/cam/carma_getH2SO4.F90 | 34 +- src/physics/carma/cam/carma_getT.F90 | 34 +- src/physics/carma/cam/carma_intr.F90 | 941 ++++++++---------- .../carma/models/dust/carma_model_mod.F90 | 304 +++--- .../models/meteor_impact/carma_model_mod.F90 | 302 +++--- .../carma/models/sea_salt/carma_model_mod.F90 | 367 ++++--- 14 files changed, 1045 insertions(+), 1082 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index a408d6433e..9606088b4d 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -8,8 +8,8 @@ required = True [carma] local_path = src/physics/carma/base protocol = git -repo_url = https://github.com/ESCOMP/CARMA_base.git -tag = carma4_00 +repo_url = https://github.com/fvitt/CARMA_base.git +branch = unstructured_grids required = True [cosp2] @@ -71,4 +71,3 @@ required = True [externals_description] schema_version = 1.0.0 - diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index b5ce306c32..eb61171efe 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -123,6 +123,7 @@ atm/waccm/ic/aqua.cam6.waccmsc_1.9x2.5_L70.2000-01-01.c170123.nc atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc +atm/waccm/ic/aqua_waccm_ma_ne5np4_70L_c220729.nc atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc atm/waccm/ic/f2000.waccm-mam3_10x15_L70.cam2.i.0017-01-01.c141016.nc atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam index 377cbb2295..cfac3a4818 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam @@ -4,5 +4,6 @@ nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. +fincl2 = 'CRSLERFC' carma_do_fixedinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam index f69245ce24..36487d1f35 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam @@ -8,4 +8,7 @@ carma_do_fixedinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" solar_data_type='FIXED' solar_data_ymd=20000101 - +carma_emis_maxlat = 40. +carma_emis_maxlon = 20. +carma_emis_minlat = -20. +carma_emis_minlon = -80. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam index c080a8a8aa..5b78ea3798 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam @@ -7,7 +7,7 @@ history_carma=.true. carma_do_fixedinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', - 'HCFC22', 'N2O', 'OCS' + 'HCFC22', 'N2O', 'OCS' solar_data_type='FIXED' solar_data_ymd=20000101 - +carma_maxretries = 40 diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam index b40ad17f97..3f4d9cf0b3 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam @@ -4,6 +4,6 @@ nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. -carma_do_fixedinit=.false. +carma_do_fixedinit=.true. carma_do_partialinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/src/physics/carma/cam/carma_constants_mod.F90 b/src/physics/carma/cam/carma_constants_mod.F90 index 27c8055095..10715cd1e6 100644 --- a/src/physics/carma/cam/carma_constants_mod.F90 +++ b/src/physics/carma/cam/carma_constants_mod.F90 @@ -18,82 +18,82 @@ module carma_constants_mod !-- ! Physical constants - + ! Meter-Kilogram-Second (MKS) convention for units - ! This convention is different from CARMA's original + ! This convention is different from CARMA's original ! Centimeter-Gram-Second (CGS) convention. Be wary of ! this conversion to the new convention. - + ! Use the _f for all literal constants, e.g. 1.2e_f. ! If you omit the _f in the initialization, a compiler may cast this ! number into single precision and then store it as _f precision. - + !! Define triple-point temperature (K) real(kind=f), parameter :: T0 = SHR_CONST_TKTRIP - - ! Define constants for circles and trig - real(kind=f), parameter :: PI = p_pi + + ! Define constants for circles and trig + real(kind=f), parameter :: PI = p_pi real(kind=f), parameter :: DEG2RAD = PI / 180._f real(kind=f), parameter :: RAD2DEG = 180._f / PI - + !! Define avogadro's number [ # particles / mole ] real(kind=f), parameter :: AVG = avogad / 1000._f - + !! Define Boltzmann's constant [ erg / deg_K ] real(kind=f), parameter :: BK = boltz * 1e7_f - + !! Define Loschmidt's number [ mole / cm^3, @ STP ] real(kind=f), parameter :: ALOS = 2.68719e+19_f - + !! Define reference pressure, e.g. for potential temp calcs [ dyne / cm^2 ] real(kind=f), parameter :: PREF = 1000.e+3_f - + !! Define conversion factor for mb to cgs [ dyne / cm^2 ] units real(kind=f), parameter :: RMB2CGS = 1000.e+0_f - + !! Define conversion factor for Pa to cgs [ dyne / cm^2 ] units real(kind=f), parameter :: RPA2CGS = 10.e+0_f !! Define conversion factor for m to cgs [ cm ] units real(kind=f), parameter :: RM2CGS = 100.0_f - + !! Define universal gas constant [ erg / deg_K / mole ] real(kind=f), parameter :: RGAS = r_universal * 1e7_f / 1000._f - + !! Define number of seconds per the planet's day [ s / d ] real(kind=f), parameter :: SCDAY = SHR_CONST_CDAY - + !! Define mass density of liquid water [ g / cm^3 ] real(kind=f), parameter :: RHO_W = rhoh2o / 1000._f - + !! Define mass density of water ice [ g / cm^3 ] real(kind=f), parameter :: RHO_I = SHR_CONST_RHOICE / 1000._f !! Latent heat of evaporation for gas [cm^2/s^2] real(kind=f), parameter :: RLHE_CNST = latvap * 1e4_f - + !! Latent heat of ice melting for gas [cm^2/s^2] real(kind=f), parameter :: RLHM_CNST = latice * 1e4_f - - + + !! The dimension of THETD, ELTRMX, CSTHT, PI, TAU, SI2THT. !! IT must correspond exactly to the second dimension of ELTRMX. integer, parameter :: IT = 1 - - !! String length of names + + !! String length of names integer, parameter :: CARMA_NAME_LEN = 255 - !! String length of short names + !! String length of short names integer, parameter :: CARMA_SHORT_NAME_LEN = 6 - + !! Fill value indicating no value is being returned real(kind=f), parameter :: CAM_FILL = fillvalue - + !! Define particle number concentration [ # / cm3 ] !! used to decide whether to bypass microphysical processes. real(kind=f), parameter :: FEW_PC = 1e-6_f - + !! Define small particle number concentration !! [ # / x_units / y_units / z_units ] !! @@ -105,48 +105,49 @@ module carma_constants_mod !! For degree/degree/hybrid coordinates, the metric is on the !! order of 1e20. ! real(kind=f), parameter :: SMALL_PC = 1e-50_f - real(kind=f), parameter :: SMALL_PC = FEW_PC * 1e20 * 1e-30 - +! real(kind=f), parameter :: SMALL_PC = FEW_PC * 1e20 * 1e-30 ! with xmet,ymet=1 this needs to change + real(kind=f), parameter :: SMALL_PC = FEW_PC * 1.e-30_f ! ?? + !! Define core fraction (for core mass and second moment) used !! when particle number concentrations are limited to SMALL_PC real(kind=f), parameter :: FIX_COREF = 0.1_f - - !! Minimum Cloud Fraction + + !! Minimum Cloud Fraction real(kind=f), parameter :: CLDFRC_MIN = 0.009_f - + !! Incloud Cloud Fraction Threshold for statistics real(kind=f), parameter :: CLDFRC_INCLOUD = 0.01_f - + !! NWAVE should be the total number of bands CAM supports. integer, public, parameter :: NWAVE = nlwbands+nswbands ! Number of wavelength bands - - - + + + !! These are constants per CARMA's definition, but are set dynamically in CAM and thus !! can not be set as constants. They must be initialized as variables in carma_init. - + !! Acceleration of gravity near Earth surface [ cm/s^2 ] real(kind=f) :: GRAV - + !! Define planet equatorial radius [ cm ] real(kind=f) :: REARTH - + !! Define molecular weight of dry air [ g / mole ] real(kind=f) :: WTMOL_AIR - + !! Define molecular weight of water [ g / mole ] real(kind=f) :: WTMOL_H2O - + !! Define gas constant for dry air [ erg / deg_K / mole ] real(kind=f) :: R_AIR - + !! Define specific heat at constant pres of dry air [ cm^2 / s^2 / deg_K ] real(kind=f) :: CP !! Define ratio of gas constant for dry air and specific heat real(kind=f) :: RKAPPA - -end module + +end module diff --git a/src/physics/carma/cam/carma_getH2O.F90 b/src/physics/carma/cam/carma_getH2O.F90 index 436042d6f6..050644a1b2 100644 --- a/src/physics/carma/cam/carma_getH2O.F90 +++ b/src/physics/carma/cam/carma_getH2O.F90 @@ -2,13 +2,14 @@ ! ! NOTE: This needs to be in its own file to avoid circular references. subroutine carma_getH2O(h2o) - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_initfiles, only: initial_file_get_id - use pio, only: file_desc_t - use cam_pio_utils, only: cam_pio_get_var - use pmgrid, only: plat, plev, plevp, plon - use ppgrid, only: pcols, pver, pverp - use cam_abortutils, only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_initfiles, only: initial_file_get_id + use pio, only: file_desc_t + use ppgrid, only: pcols, pver, begchunk, endchunk + use cam_abortutils, only: endrun + use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names + use ncdio_atm, only: infld + use gmean_mod, only: gmean real(r8), intent(out) :: h2o(pver) ! midpoint h2o mmr (kg/kg) @@ -16,25 +17,32 @@ subroutine carma_getH2O(h2o) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_h2o(:,:,:) + integer :: grid_id + character(len=4) :: dim1name, dim2name + character(len=*), parameter :: subname = 'carma_getH2O' ! For an initial run, if the file is missing, then create one using the ! average concentration from the initial condition file. ncid_ini => initial_file_get_id() - nullify(init_h2o) - allocate(init_h2o(plon,pver,plat)) - call cam_pio_get_var('Q', ncid_ini, init_h2o, found=found) - + allocate(init_h2o(pcols,pver,begchunk:endchunk)) + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(subname//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + call infld('Q', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_h2o, found, gridname='physgrid') + if (.not. found) then - call endrun('carma_init::cam_pio_get_var failed to find field Q.') + call endrun(subname//': failed to find field Q in IC file.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - h2o(iz) = sum(init_h2o(:, iz, :)) / plat / plon + call gmean(init_h2o(:, iz, :), h2o(iz)) end do deallocate(init_h2o) - - return - end + + end subroutine carma_getH2O diff --git a/src/physics/carma/cam/carma_getH2SO4.F90 b/src/physics/carma/cam/carma_getH2SO4.F90 index 0472656529..0b1c47d93d 100644 --- a/src/physics/carma/cam/carma_getH2SO4.F90 +++ b/src/physics/carma/cam/carma_getH2SO4.F90 @@ -5,10 +5,11 @@ subroutine carma_getH2SO4(h2so4) use shr_kind_mod, only: r8 => shr_kind_r8 use cam_initfiles, only: initial_file_get_id use pio, only: file_desc_t - use cam_pio_utils, only: cam_pio_get_var - use pmgrid, only: plat, plev, plevp, plon - use ppgrid, only: pcols, pver, pverp + use ppgrid, only: pcols, pver, begchunk, endchunk use cam_abortutils, only: endrun + use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names + use ncdio_atm, only: infld + use gmean_mod, only: gmean real(r8), intent(out) :: h2so4(pver) ! midpoint h2so4 mmr (kg/kg) @@ -16,25 +17,32 @@ subroutine carma_getH2SO4(h2so4) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_h2so4(:,:,:) + integer :: grid_id + character(len=4) :: dim1name, dim2name + character(len=*), parameter :: subname = 'carma_getH2SO4' ! For an initial run, if the file is missing, then create one using the ! average concentration from the initial condition file. - ncid_ini => initial_file_get_id() - nullify(init_h2so4) + ncid_ini => initial_file_get_id() + + allocate(init_h2so4(pcols,pver,begchunk:endchunk)) + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(subname//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + call infld('H2SO4', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_h2so4, found, gridname='physgrid') - allocate(init_h2so4(plon,pver,plat)) - call cam_pio_get_var('H2SO4', ncid_ini, init_h2so4, found=found) - if (.not. found) then - call endrun('carma_init::cam_pio_get_var failed to find field H2SO4.') + call endrun(subname//': failed to find field H2SO4 in IC file.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - h2so4(iz) = sum(init_h2so4(:, iz, :)) / plat / plon + call gmean(init_h2so4(:, iz, :), h2so4(iz)) end do deallocate(init_h2so4) - - return - end + + end subroutine carma_getH2SO4 diff --git a/src/physics/carma/cam/carma_getT.F90 b/src/physics/carma/cam/carma_getT.F90 index 27bf928b98..ab3ccae28e 100644 --- a/src/physics/carma/cam/carma_getT.F90 +++ b/src/physics/carma/cam/carma_getT.F90 @@ -5,10 +5,11 @@ subroutine carma_getT(T) use shr_kind_mod, only: r8 => shr_kind_r8 use cam_initfiles, only: initial_file_get_id use pio, only: file_desc_t - use cam_pio_utils, only: cam_pio_get_var - use pmgrid, only: plat, plev, plevp, plon - use ppgrid, only: pcols, pver, pverp + use ppgrid, only: pcols, pver, begchunk, endchunk use cam_abortutils, only: endrun + use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names + use ncdio_atm, only: infld + use gmean_mod, only: gmean real(r8), intent(out) :: T(pver) ! midpoint temperature (Pa) @@ -16,25 +17,32 @@ subroutine carma_getT(T) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_t(:,:,:) + integer :: grid_id + character(len=4) :: dim1name, dim2name + character(len=*), parameter :: subname = 'carma_getT' ! For an initial run, if the file is missing, then create one using the average ! temperature from the initial condition file. - ncid_ini => initial_file_get_id() - nullify(init_t) + ncid_ini => initial_file_get_id() + + allocate(init_t(pcols,pver,begchunk:endchunk)) + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(subname//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + call infld('T', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_t, found, gridname='physgrid') - allocate(init_t(plon,pver,plat)) - call cam_pio_get_var('T', ncid_ini, init_t, found=found) - if (.not. found) then - call endrun('carma_init::cam_pio_get_var failed to find field T.') + call endrun(subname//': failed to find field T in IC file.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - T(iz) = sum(init_t(:, iz, :)) / plat / plon + call gmean(init_t(:, iz, :), T(iz)) end do deallocate(init_t) - - return - end + + end subroutine carma_getT diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index fabfb467ac..20c139e646 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -21,7 +21,7 @@ module carma_intr use carmasolute_mod use carmastate_mod use carma_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc use pmgrid, only: plat, plev, plevp, plon @@ -41,15 +41,15 @@ module carma_intr #if ( defined SPMD ) use mpishorthand -#endif - +#endif + implicit none - + private save ! Public interfaces - + ! CAM Physics Interface public carma_register ! register consituents public carma_is_active ! retrns true if this package is active (microphysics = .true.) @@ -60,16 +60,16 @@ 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 - + ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function public carma_wetdep_tend ! calculate tendency from wet deposition - + ! Private data - + ! Particle Group Statistics - + ! Gridbox average integer, parameter :: NGPDIAGS = 12 ! Number of particle diagnostics ... integer, parameter :: GPDIAGS_ND = 1 ! Number density @@ -88,13 +88,13 @@ module carma_intr ! Particle Bin (Element) Statistics integer, parameter :: NBNDIAGS = 1 ! Number of bin surface diagnostics ... integer, parameter :: BNDIAGS_TP = 1 ! Delta Particle Temperature [K] - + ! Surface integer, parameter :: NSBDIAGS = 2 ! Number of bin surface diagnostics ... integer, parameter :: SBDIAGS_DD = 1 ! Dry deposition flux [kg/m2/s] integer, parameter :: SBDIAGS_VD = 2 ! Dry deposition velocity [cm/s] - - + + ! Gas Statistics integer, parameter :: NGSDIAGS = 5 ! Number of gas diagnostics ... integer, parameter :: GSDIAGS_SI = 1 ! saturation wrt ice @@ -102,27 +102,27 @@ module carma_intr integer, parameter :: GSDIAGS_EI = 3 ! equilibrium vp wrt ice integer, parameter :: GSDIAGS_EL = 4 ! equilibrium vp wrt water integer, parameter :: GSDIAGS_WT = 5 ! weight percent composition for aerosols - + ! Step Statistics integer, parameter :: NSPDIAGS = 2 ! Number of step diagnostics ... integer, parameter :: SPDIAGS_NSTEP = 1 ! number of substeps integer, parameter :: SPDIAGS_LNSTEP = 2 ! ln(number of substeps) - + ! Defaults not in the namelist character(len=10), parameter :: carma_mixtype = 'wet' ! mixing ratio type for CARMA constituents integer :: LUNOPRT = -1 ! lun for output - - ! Constituent Mappings + + ! Constituent Mappings integer :: icnst4elem(NELEM, NBIN) ! constituent index for a carma element integer :: icnst4gas(NGAS) ! constituent index for a carma gas character(len=16) :: btndname(NGROUP, NBIN) ! names of group per bin tendencies character(len=16) :: etndname(NELEM, NBIN) ! names of element tendencies character(len=16) :: gtndname(NGAS) ! names of gas tendencies - + ! Flags to indicate whether each constituent could have a CARMA tendency. logical :: lq_carma(pcnst) - + ! The CARMA object stores the configuration inforamtion about CARMA, only one is ! is needed per MPI task. In the future, this could potentially be turned into one ! per model to allow multiple models with different numbers of bins, ... to be @@ -133,12 +133,12 @@ module carma_intr type(carma_type), target :: carma ! the carma object - ! Physics Buffer Indicies + ! Physics Buffer Indicies integer :: ipbuf4gas(NGAS) ! physics buffer index for a carma gas integer :: ipbuf4t ! physics buffer index for a carma temperature integer :: ipbuf4sati(NGAS) ! physics buffer index for a carma saturation over ice integer :: ipbuf4satl(NGAS) ! physics buffer index for a carma saturation over liquid - + ! Globals used for a reference atmosphere. real(kind=f) :: carma_t_ref(pver) ! midpoint temperature (Pa) real(kind=f) :: carma_h2o_ref(pver) ! h2o mmmr (kg/kg) @@ -209,13 +209,13 @@ subroutine carma_register ! Initialize the return code. rc = 0 - + ! Some constants are set on the fly in CAM, so initialize them and any derived "constants" here. ! Some of them are needed in CARMA_DefineModel and CARMA_Initialize. GRAV = gravit * RM2CGS - REARTH = p_rearth * RM2CGS - WTMOL_AIR = mwdry - WTMOL_H2O = mwh2o + REARTH = p_rearth * RM2CGS + WTMOL_AIR = mwdry + WTMOL_H2O = mwh2o R_AIR = RGAS / WTMOL_AIR CP = cpair * 1.e7_r8 / 1000._r8 RKAPPA = R_AIR / CP @@ -225,7 +225,7 @@ subroutine carma_register ! Find out which radiation scheme is active. call phys_getopts(radiation_scheme_out = radiation_scheme) - + ! Get the wavelength centers for the CAM longwave and shortwave bands ! from the radiation code. @@ -251,15 +251,15 @@ subroutine carma_register ! Create the CARMA object that will contain all the information about the ! how CARMA is configured. - + call CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, & LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit) if (rc < 0) call endrun('carma_register::CARMA_Create failed.') - + ! Define the microphysical model. call CARMA_DefineModel(carma, rc) if (rc < 0) call endrun('carma_register::CARMA_DefineModel failed.') - + if (masterproc) then write(LUNOPRT,*) '' write(LUNOPRT,*) 'CARMA general settings for ', trim(carma_model), ' model : ' @@ -301,7 +301,7 @@ subroutine carma_register write(LUNOPRT,*) ' carma_rad_feedback = ', carma_rad_feedback write(LUNOPRT,*) '' endif - + ! Intialize the model based upon the namelist configuration. ! ! NOTE: When used with CAM, the latents heats (of melting and evaporation) @@ -337,8 +337,8 @@ subroutine carma_register gstickl = carma_gstickl, & tstick = carma_tstick) if (rc < 0) call endrun('carma_register::CARMA_Initialize failed.') - - + + ! The elements and gases from CARMA need to be added as constituents in ! CAM (if they don't already exist). For the elements, each radius bin ! needs to be its own constiuent in CAM. @@ -349,34 +349,34 @@ subroutine carma_register ! 2) The molecular weight is in kg/kmol. ! 3) The specific heat at constant pressure is in J/kg/K. ! 4) The consituents are added sequentially. - + ! Add a CAM constituents for each bin of each element. do ielem = 1, NELEM - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup, shortname=shortname, name=name) if (rc < 0) call endrun('carma_register::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, shortname=grp_short) if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.') - + ! For prognostic groups, all of the bins need to be represented as actual CAM ! constituents. Diagnostic groups are determined from state information that ! is already present in CAM, and thus their bins only exist in CARMA. if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + do ibin = 1, NBIN - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin write(c_name, '(A, I2.2)') trim(shortname), ibin write(c_longname, '(A, e11.4, A)') trim(name) // ', ', r(ibin)*1.e4_r8, ' um' - + ! The molecular weight seems to be used for molecular diffusion, which - ! doesn't make sense for particles. The CAM solvers are unstable if the + ! doesn't make sense for particles. The CAM solvers are unstable if the ! mass provided is large. call cnst_add(c_name, WTMOL_AIR, cpair, 0._r8, icnst4elem(ielem, ibin), & longname=c_longname, mixtype=carma_mixtype, is_convtran1=is_convtran1(igroup)) @@ -384,28 +384,28 @@ subroutine carma_register end do end if end do - + ! Find the constituent for the gas or add it if not found. do igas = 1, NGAS - + call CARMAGAS_Get(carma, igas, rc, shortname=shortname, name=name, wtmol=wtmol) if (rc < 0) call endrun('carma_register::CARMAGAS_Get failed.') - + ! Is the gas already defined? call cnst_get_ind(shortname, icnst4gas(igas)) - + ! For substepping, we need to store the last mmr values for the gas. call pbuf_add_field('CG' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4gas(igas)) - + ! For substepping, we need to store the last supersaturations. call pbuf_add_field('CI' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4sati(igas)) call pbuf_add_field('CL' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4satl(igas)) end do - - + + ! For substepping, we need to store the temperature. call pbuf_add_field('CT', 'global',dtype_r8, (/pcols, pver/), ipbuf4t) - + ! Create the optical properties files needed for RRTMG radiative transfer ! calculations. @@ -418,7 +418,7 @@ subroutine carma_register call CARMA_CreateOpticsFile(carma, rc) if (rc < 0) call endrun('carma_register::carma_CreateOpticsFiles failed.') end if - + return end subroutine carma_register @@ -431,11 +431,11 @@ end subroutine carma_register !! @version May 2009 function carma_is_active() implicit none - + logical :: carma_is_active - + carma_is_active = carma_flag - + return end function carma_is_active @@ -448,38 +448,38 @@ end function carma_is_active !! @version May 2009 function carma_implements_cnst(name) implicit none - + character(len=*), intent(in) :: name !! constituent name logical :: carma_implements_cnst ! return value - + integer :: igroup integer :: ielem integer :: ibin integer :: igas integer :: rc - + integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin rc = 0 - + carma_implements_cnst = .false. - + ! Check each bin to see if it this constituent. do ielem = 1, NELEM do ibin = 1, NBIN call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) - if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') - + if (rc < 0) call endrun('carma_implements_cnst::CARMAELEMENT_Get failed.') + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) - if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') - + if (rc < 0) call endrun('carma_implements_cnst::CARMAGROUP_Get failed.') + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + if (name == cnst_name(icnst4elem(ielem, ibin))) then carma_implements_cnst = .true. return @@ -487,8 +487,8 @@ function carma_implements_cnst(name) end if end if end do - end do - + end do + ! Check each gas to see if it this constituent. do igas = 1, NGAS if (name == cnst_name(icnst4gas(igas))) then @@ -496,10 +496,10 @@ function carma_implements_cnst(name) return end if end do - + return end function carma_implements_cnst - + !! Initialize items in CARMA that only need to be initialized once. This !! routine is called after carma_register has been called. @@ -516,7 +516,7 @@ subroutine carma_init use phys_control, only: phys_getopts implicit none - + integer :: iz ! vertical index integer :: ielem ! element index integer :: ibin ! bin index @@ -529,17 +529,15 @@ subroutine carma_init integer :: maxbin ! last prognostic bin logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? - - integer :: i + integer :: ier - integer :: ncid, dimid_lev, lev, vid_T + integer :: ncid, dimid_lev, vid_T logical :: lexist character(len=256) :: locfn integer :: nlev integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? logical :: history_carma - 1 format(a6,4x,a11,4x,a11,4x,a11) 2 format(i6,4x,3(1pe11.3,4x)) @@ -552,34 +550,34 @@ subroutine carma_init ! Set names of constituent sources and declare them as history variables; howver, ! only prognostic variables have. lq_carma(:) = .false. - + do ielem = 1, NELEM do ibin = 1, NBIN call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + ! Indicate that this is a constituent whose tendency could be changed by ! CARMA. lq_carma(icnst) = .true. - + etndname(ielem, ibin) = trim(cnst_name(icnst)) - + call addfld(cnst_name(icnst), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(icnst)) if (history_carma) then call add_default(cnst_name(icnst), 1, ' ') end if - + call addfld(trim(etndname(ielem, ibin))//'TC', (/ 'lev' /), 'A', 'kg/kg/s', & trim(cnst_name(icnst)) // ' tendency') call addfld(trim(etndname(ielem, ibin))//'SF', horiz_only, 'A', 'kg/m2/s', & @@ -608,7 +606,7 @@ subroutine carma_init do igroup = 1, NGROUP call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep) if (rc < 0) call endrun('carma_init::CARMAGROUP_GetGroup failed.') - + ! Gridbox average ! ! NOTE: Would like use flag_xf_fill for the reffective radius fields, but cam_history @@ -647,6 +645,7 @@ subroutine carma_init ! Per bin stats .. if (do_drydep) then do ibin = 1, NBIN + !!! WHAT is icnst here ?????? call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & trim(cnst_name(icnst)) // ' dry deposition velocity') end do @@ -674,17 +673,17 @@ subroutine carma_init trim(cnst_name(icnst)) // ' equilibrium vmr wrt liquid') call addfld(trim(cnst_name(icnst))//'WT', (/ 'lev' /), 'A', '%', & trim(cnst_name(icnst)) // ' weight percent aerosol composition') - + if (history_carma) then call add_default(trim(cnst_name(icnst))//'SI', 1, ' ') call add_default(trim(cnst_name(icnst))//'SL', 1, ' ') end if end do - + if (carma_do_thermo) then call addfld('CRTT', (/ 'lev' /), 'A', 'K/s', ' CARMA temperature tendency') end if - + ! Add fields for diagnostic fields, and make them defaults on the first tape. if (carma_do_substep) then call addfld('CRNSTEP', (/ 'lev' /), 'A', ' ', 'number of carma substeps') @@ -695,8 +694,8 @@ subroutine carma_init call add_default('CRLNSTEP', 1, ' ') end if end if - - + + ! Set up the reference atmosphere that can be used for fixed initialization. This is ! an approximate atmospheric used to define average fall velocities, coagulation ! kernels, and growth parameters. @@ -705,7 +704,7 @@ subroutine carma_init ! NOTE: Reading the initial condtion file using the supplied routines must ! be done outside of masterproc, so does this in all threads before deciding ! if it will be used. The initial condition file is only opened on an initial run. - if (is_first_step()) then + if (is_first_step()) then call carma_getT(carma_t_ref) if (carma%f_igash2o /= 0) call carma_getH2O(carma_h2o_ref) if (carma%f_igash2So4 /= 0) call carma_getH2SO4(carma_h2so4_ref) @@ -714,49 +713,49 @@ subroutine carma_init if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun('carma_init::CARMA_Get failed.') - + if (do_print) write(LUNOPRT,*) "" if (do_print) write(LUNOPRT,*) "CARMA initializing to fixed reference state." if (do_print) write(LUNOPRT,*) "" - + ! For temperature, get the average temperature from reference temperature file ! if it exists or from the initial condition file if the reference temperature file ! doesn't exist. ! ! NOTE: The reference temperature file will only be created for an inital run. It ! must already exist for a restart run. - + ! Does reference temperature file already exist? call getfil(carma_reftfile, locfn, iflag=1) - + inquire(file=locfn, exist=lexist) - + ! Read the reference temperature from the file. if (lexist) then - + ! Open the netcdf file. call wrap_open(trim(locfn), NF90_NOWRITE, ncid) - + ! Inquire about dimensions call wrap_inq_dimid(ncid, 'lev', dimid_lev) call wrap_inq_dimlen(ncid, dimid_lev, nlev) - + ! Does the number of levels match? if (nlev /= pver) then call endrun("carma_init::ERROR - Incompatible number of levels & &in the CARMA reference temperature file ... " // trim(locfn)) end if - + ! Get variable ID for reference temperature call wrap_inq_varid(ncid, 'T', vid_T) - + ! Read in the temperature data. call wrap_get_var_realx(ncid, vid_T, carma_T_ref) if (carma%f_igash2o /= 0) then ! Get variable ID for reference temperature call wrap_inq_varid(ncid, 'Q', vid_T) - + ! Read in the temperature data. call wrap_get_var_realx(ncid, vid_T, carma_h2o_ref) end if @@ -764,25 +763,25 @@ subroutine carma_init if (carma%f_igash2so4 /= 0) then ! Get variable ID for reference temperature call wrap_inq_varid(ncid, 'H2SO4', vid_T) - + ! Read in the temperature data. call wrap_get_var_realx(ncid, vid_T, carma_h2so4_ref) end if - + ! Close the file call wrap_close(ncid) - + ! Is this an initial or restart run? else if (is_first_step()) then if (do_print) write(LUNOPRT,*) "" if (do_print) write(LUNOPRT,*) 'Creating CARMA reference temperature file ... ', trim(locfn) - + ! Save the average into a file to be used for restarts. call CARMA_CreateRefTFile(carma, locfn, pref_mid(:) / 100._r8, & carma_t_ref(:), rc, refh2o=carma_h2o_ref(:), refh2so4=carma_h2so4_ref(:)) else - + ! The file must already exist for a restart run. call endrun("carma_init::ERROR - Can't find the CARMA reference temperature file ... " // trim(carma_reftfile)) @@ -791,14 +790,14 @@ subroutine carma_init ! Write out the values that are being used. if (do_print) write(LUNOPRT,*) "" if (do_print) write(LUNOPRT,1) "Level","Int P (Pa)","Mid P (Pa)","Mid T (K)" - + do iz = 1, pver if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), pref_mid(iz), carma_t_ref(iz) end do if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), 0.0_r8, 0.0_r8 if (do_print) write(LUNOPRT,*) "" end if - + #ifdef SPMD ! Communicate the settings to the other MPI tasks. @@ -810,7 +809,7 @@ subroutine carma_init ! Do a model specific initialization. call CARMA_InitializeModel(carma, lq_carma, rc) if (rc < 0) call endrun('carma_init::CARMA_InitializeModel failed.') - + return end subroutine carma_init @@ -823,18 +822,18 @@ end subroutine carma_init !! @version October 2009 subroutine carma_final implicit none - + integer :: rc ! CARMA return code integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - + 2 format(' carma_final: overall substepping statistics',/,& ' max nsubstep=',1F9.0,/,' avg nsubstep=',1F9.2,/,& ' max nretry=',1F9.0,/,' avg nretry=',1F10.4) ! Initialize the return code. rc = 0 - + ! Output the end of run statistics for CARMA if (carma_do_substep) then if (masterproc) then @@ -854,12 +853,12 @@ subroutine carma_final end if end if end if - - + + ! Do a model specific initialization. call CARMA_Destroy(carma, rc) if (rc < 0) call endrun('carma_final::CARMA_Destroy failed.') - + return end subroutine carma_final @@ -881,7 +880,7 @@ subroutine carma_timestep_init step_nstep = 0._f step_nsubstep = 0._f step_nretry = 0._f - + return end subroutine carma_timestep_init @@ -906,9 +905,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli prec_sed, snow_sed, ustar, obklen) use time_manager, only: get_nstep, get_step_size, is_first_step use camsrfexch, only: cam_in_t, cam_out_t - use scamMod, only: single_column use planck, only: planckIntensity - + implicit none type(physics_state), intent(in) :: state !! physics state variables @@ -919,7 +917,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) @@ -932,26 +930,20 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(carmastate_type) :: cstate ! the carma state object integer :: igroup ! group index integer :: ielem ! element index - integer :: ielem_nd ! index of numder density element in group integer :: ibin ! bin index integer :: igas ! gas index integer :: icol ! column index integer :: icnst ! constituent index integer :: icnst_q ! H2O constituent index - integer :: ncol ! number of columns integer :: rc ! CARMA return code integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin - real(r8) :: spdiags(pcols, pver, NSPDIAGS) ! CARMA step diagnostic output - real(r8) :: gsdiags(pcols, pver, NGAS, NGSDIAGS) ! CARMA gas diagnostic output - real(r8) :: gpdiags(pcols, pver, NGROUP, NGPDIAGS) ! CARMA group diagnostic output - real(r8) :: sbdiags(pcols, NBIN, NELEM, NSBDIAGS) ! CARMA surface bin diagnostic output - real(r8) :: bndiags(pcols, pver, NBIN, NELEM, NBNDIAGS) ! CARMA bin diagnostic output + real(r8) :: spdiags(pcols, pver, NSPDIAGS) ! CARMA step diagnostic output + real(r8) :: gsdiags(pcols, pver, NGAS, NGSDIAGS) ! CARMA gas diagnostic output + real(r8) :: gpdiags(pcols, pver, NGROUP, NGPDIAGS) ! CARMA group diagnostic output + real(r8) :: sbdiags(pcols, NBIN, NELEM, NSBDIAGS) ! CARMA surface bin diagnostic output + real(r8) :: bndiags(pcols, pver, NBIN, NELEM, NBNDIAGS) ! CARMA bin diagnostic output real(r8) :: newstate(pver) ! next state for a physics state field - real(r8) :: xc(pver) ! x center - real(r8) :: dx(pver) ! x width - real(r8) :: yc(pver) ! y center - real(r8) :: dy(pver) ! y width real(r8) :: dz(pver) ! z width real(r8) :: satice(pver) ! saturation wrt ice real(r8) :: satliq(pver) ! saturation wrt liquid @@ -959,12 +951,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8) :: eqliq(pver) ! equil vp wrt liquid real(r8) :: wtpct(pver) ! weight percent aerosol composition real(r8) :: time ! the total elapsed time (s) - real(r8) :: dlat ! latitude spacing real(r8) :: r(NBIN) ! particle radius (cm) real(r8) :: rmass(NBIN) ! particle mass (g) real(r8) :: rrat(NBIN) ! particle maximum radius ratio () real(r8) :: arat(NBIN) ! particle area ration () - real(r8) :: rhoelem ! element density (g) real(r8) :: nd(pver) ! number density (cm-3) real(r8) :: ad(pver) ! area density (um2/cm3) real(r8) :: md(pver) ! mass density (g cm-3) @@ -976,7 +966,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8) :: re2(pver) ! N(r)*r^2 (cm2) real(r8) :: re3(pver) ! N(r)*r^3 (cm3) real(r8) :: pa(pver) ! Projected Area (cm2) - real(r8) :: ar(pver) ! Area Ratio + real(r8) :: ar(pver) ! Area Ratio real(r8) :: vm(pver) ! Massweighted fall velocity (cm2) real(r8) :: jn(pver) ! nucleation (cm-3) real(r8) :: numberDensity(pver) ! number density (cm-3) @@ -998,8 +988,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) integer :: lchnk ! chunk identifier - real(r8) :: coremmr(pver) - real(r8) :: ttlmmr(pver) integer :: iz real(r8) :: cldfrc(pver) ! cloud fraction [fraction] real(r8) :: rhcrit(pver) ! relative humidity for onset of liquid clouds [fraction] @@ -1021,7 +1009,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(kind=f) :: zsubsteps(pver) logical :: is_cloud ! is the group a cloud? logical :: is_ice ! is the group ice? - integer :: ienconc logical :: grp_do_drydep ! is dry depostion enabled for group? logical :: do_drydep ! is dry depostion enabled? logical :: do_fixedinit ! do initialization from reference atm? @@ -1030,42 +1017,42 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length [m] real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length [m] - + ! Initialize the return code. rc = 0 ! Initialize the output tendency structure. call physics_ptend_init(ptend,state%psetcols,'CARMA', ls=carma_do_thermo, lq=lq_carma) - + if (present(prec_sed)) prec_sed(:) = 0._f if (present(snow_sed)) snow_sed(:) = 0._f if (present(prec_str)) prec_str(:) = 0._f if (present(snow_str)) snow_str(:) = 0._f - + if (.not. carma_flag) return ! Determine the current time in seconds. time = dt * get_nstep() - 1 - + ! The CARMA interface assumes that mass mixing ratios are relative to a ! wet atmosphere, so convert any dry mass mixing ratios to wet. call physics_state_copy(state, state_loc) call set_dry_to_wet(state_loc) - + spdiags(:, :, :) = 0.0_r8 gpdiags(:, :, :, :) = 0.0_r8 gsdiags(:, :, :, :) = 0.0_r8 sbdiags(:, :, :, :) = 0.0_r8 bndiags(:, :, :, :, :) = 0.0_r8 - + ! Find the constituent index for water vapor. call cnst_get_ind('Q', icnst_q) - + ! Get pointers into pbuf ... lchnk = state_loc%lchnk - + call pbuf_get_field(pbuf, ipbuf4t, t_ptr) - + ! If doing particle heating, then get pointers to the spectral flux data provided ! by the radiation code in the physics buffer. ! @@ -1077,7 +1064,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call pbuf_get_field(pbuf, pbuf_get_index("LU"), lu_ptr) call pbuf_get_field(pbuf, pbuf_get_index("LD"), ld_ptr) end if - + ! Cloud ice pbuf fields if (carma_do_cldice) then call pbuf_get_field(pbuf, pbuf_get_index("TND_QSNOW"), tnd_qsnow) @@ -1096,23 +1083,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! call CARMA_Get(carma, rc, do_fixedinit=do_fixedinit, do_drydep=do_drydep) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') - + if (do_fixedinit) then - - ! The latitude and longitude are arbitrary, but the dimensions need to be correct. - xc = 255._r8 - yc = 40._r8 - - ! Assume resolution is 64x128. - if (single_column) then -! dx = 360._r8 / 128._r8 -! dy = 180._r8 / 64._r8 - else - - ! Calculate the x and y coordinates, in degrees latitude and longitude. -! dx = 360._r8 / plon -! dy = 180._r8 / (plat-1) - end if call CARMASTATE_CreateFromReference(cstate, & carma_ptr, & @@ -1120,13 +1092,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli dt, & pver, & I_HYBRID, & - I_LL, & 40._r8, & 255._r8, & - xc, & - dx, & - yc, & - dy, & pref_mid_norm, & pref_edge/psurf_ref, & pref_mid(:), & @@ -1141,42 +1108,11 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! Process each column. do icol = 1, state_loc%ncol - - ! Haven't figured out how to get dimensions for single column. Perhaps should change - ! CARMA to work with area rather than dx and dy. For now, just hack something. - xc(:) = state_loc%lon(icol) / DEG2RAD - yc(:) = state_loc%lat(icol) / DEG2RAD - - ! Assume resolution is 64x128. -! if (single_column) then -! dx = 360._r8 / 128._r8 -! dy = 180._r8 / 64._r8 -! else - - ! Caclulate the x and y coordinates, in degrees latitude and longitude. -! dx(:) = 360._r8 / plon - -! dlat = 180._r8 / (plat-1) - - ! The pole points need special treatment, since the point is not the - ! center of the grid box. - ! - ! In single column mode there is just one latitude, so make it global. -! if (abs(state_loc%lat(icol) / DEG2RAD) >= (90._r8 - (90._r8 / (plat-1)))) then - - ! Nudge yc toward the equator. -! yc(:) = yc(:) - sign(0.25_r8,state_loc%lat(icol)) * dlat - -! dy(:) = dlat / 2._r8 -! else -! dy(:) = dlat -! endif -! end if if (is_first_step()) then t_ptr(icol,:) = state_loc%t(icol,:) end if - + ! For particle heating, need to get the incoming radiative intensity from ! the radiation code. ! @@ -1184,11 +1120,11 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! when the compute_spectral_flux namelist variable is provided to the radiation. This ! data needs to be scaled to a radiative intensity by assuming it is isotrotropic. radint(:,:) = 0._f - + if (carma_do_pheat) then call CARMA_Get(carma, rc, dwave=dwave, wave=wave) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') - + ! CARMA may run before the radiation code for the very first time step. ! In that case, the lu, ld, su and sd values are NaN. NaN will crash ! the model, so instead substitute an approximation that is roughly a @@ -1206,17 +1142,17 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli lu_ptr(icol, iz, iwvl) = planckIntensity(wave(iwvl), state_loc%t(icol, iz)) / 1e7_f * 1e4_f * dwave(iwvl) * PI end do lu_ptr(icol, pverp, iwvl) = lu_ptr(icol, pver, iwvl) - + ld_ptr(icol, 2:pverp, iwvl) = lu_ptr(icol, 1:pver, iwvl) ld_ptr(icol, 1, iwvl) = lu_ptr(icol, 2, iwvl) end do end if - + do iwvl = 1, nlwbands radint(:, iwvl) = (lu_ptr(icol, 2:, iwvl) + ld_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(iwvl) end do - + do iwvl = 1, nswbands radint(:, nlwbands+iwvl) = (su_ptr(icol, 2:, iwvl) + sd_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(nlwbands+iwvl) end do @@ -1228,13 +1164,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli dt, & pver, & I_HYBRID, & - I_LL, & - state_loc%lat(icol) / DEG2RAD, & - state_loc%lon(icol) / DEG2RAD, & - xc, & - dx, & - yc, & - dy, & + state_loc%lat(icol) * RAD2DEG, & + state_loc%lon(icol) * RAD2DEG, & pref_mid_norm, & pref_edge/psurf_ref, & state_loc%pmid(icol, :), & @@ -1254,10 +1185,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli do ielem = 1, NELEM call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! For prognostic groups, set the bin from the corresponding constituent. @@ -1270,7 +1201,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') else newstate(:) = 0._f - + call CARMASTATE_SetBin(cstate, ielem, ibin, newstate, rc) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') end if @@ -1298,9 +1229,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call CARMA_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) - if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') - - + if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') + + ! If the model supports detraining of condensed water from convection, then pass ! along the condensed H2O. call CARMA_Get(carma, rc, do_detrain=do_detrain) @@ -1311,7 +1242,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli snow_str=snow_str, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Detrain failed.') end if - + ! Now that detrainment has happened, determine the cloud fractions. ! These will be used to scale the cloud amount to go from gridbox average to in-cloud @@ -1326,17 +1257,17 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (carma_rhcrit /= 0._f) then rhcrit(:) = carma_rhcrit end if - - + + ! For dry deposition, provide a surface friction velocity and an aerodynamic ! resistance for each of the land surface types. The values for the land come ! from the land model, but those for ocean and sea ice need to be calculated. if (do_drydep) then - + ! Land lndfv = cam_in%fv(icol) lndram = cam_in%ram1(icol) - + ! Ocean ocnfv = ustar(icol) ocnram = 0._r8 @@ -1363,15 +1294,15 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli iceram) end if end if - - + + ! Advance the microphysics one timestep. call CARMASTATE_Step(cstate, rc, cldfrc=cldfrc, rhcrit=rhcrit, & lndfv=lndfv, ocnfv=ocnfv, icefv=icefv, lndram=lndram, & ocnram=ocnram, iceram=iceram, lndfrac=cam_in%landfrac(icol), & ocnfrac=cam_in%ocnfrac(icol), icefrac=cam_in%icefrac(icol)) - if (rc < 0) call endrun('carma_timestep_tend::CARMA_Step failed.') - + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Step failed.') + ! Get the results for the CARMA particles. @@ -1393,16 +1324,16 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! Calculate the group statistics for all elements. dz(:) = state_loc%zi(icol, 1:pver) - state_loc%zi(icol, 2:pverp) - + do ielem = 1, NELEM - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, & is_cloud=is_cloud, is_ice=is_ice, do_drydep=grp_do_drydep, rrat=rrat, arat=arat) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + ! Intialize the group totals nd(:) = 0.0_r8 ad(:) = 0.0_r8 @@ -1423,26 +1354,26 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call CARMASTATE_GetBin(cstate, ielem, ibin, newstate(:), rc, & numberDensity=numberDensity, nucleationRate=nucleationRate, surface=dd, vd=vd, vf=vf, dtpart=dtpart) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetBin failed.') - + ! For prognostic groups, set the tendency from the corresponding constituents. if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + ! Update the consituent tendency. ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt - + if (grp_do_drydep) then sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd / dt sbdiags(icol, ibin, ielem, SBDIAGS_VD) = - vd / 100._r8 end if end if end if - + ! Calculate the total densities. ! ! NOTE: Convert AD to um2/cm3. @@ -1455,7 +1386,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli mr(:) = mr(:) + newstate(:) pa(:) = pa(:) + numberDensity(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) vm(:) = vm(:) + numberDensity(:) * rmass(ibin) * vf(2:) / 100._f - + ! Calculate the optical depth and extinction. ! ! NOTE: Assume Qext = 2 for optical depth. This can be pulled out of CARMA @@ -1476,11 +1407,11 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli jn(:) = jn(:) + nucleationRate(:) end if end do - + ! If this is the number element for the group, then write out the ! statistics. if (numberDensity(1) /= CAM_FILL) then - + ! Calculate the effective radius (total volume / total area). Places ! with no surface area will cause NaN values. ! @@ -1496,9 +1427,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli end where ! Store the statistics. - + ! Gridbox average - gpdiags(icol, :, igroup, GPDIAGS_ND) = nd + gpdiags(icol, :, igroup, GPDIAGS_ND) = nd gpdiags(icol, :, igroup, GPDIAGS_AD) = ad gpdiags(icol, :, igroup, GPDIAGS_MD) = md gpdiags(icol, :, igroup, GPDIAGS_RE) = re @@ -1509,14 +1440,14 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli gpdiags(icol, :, igroup, GPDIAGS_VM) = vm gpdiags(icol, :, igroup, GPDIAGS_PA) = pa gpdiags(icol, :, igroup, GPDIAGS_AR) = ar - + if (nucleationRate(1) /= CAM_FILL) then gpdiags(icol, :, igroup, GPDIAGS_JN) = jn end if end if end do - + ! Get the results for the CARMA gases. do igas = 1, NGAS call pbuf_get_field(pbuf, ipbuf4gas(igas), gc_ptr) @@ -1526,47 +1457,47 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call CARMASTATE_GetGas(cstate, igas, newstate(:), rc, satice=satice, satliq=satliq, & eqice=eqice, eqliq=eqliq, wtpct=wtpct) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetGas failed.') - + icnst = icnst4gas(igas) ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt - - gsdiags(icol, :, igas, GSDIAGS_SI) = satice(:) + + gsdiags(icol, :, igas, GSDIAGS_SI) = satice(:) gsdiags(icol, :, igas, GSDIAGS_SL) = satliq(:) - gsdiags(icol, :, igas, GSDIAGS_EI) = eqice(:) + gsdiags(icol, :, igas, GSDIAGS_EI) = eqice(:) gsdiags(icol, :, igas, GSDIAGS_EL) = eqliq(:) gsdiags(icol, :, igas, GSDIAGS_WT) = wtpct(:) - + ! Store the values needed for substepping in the physics buffer. gc_ptr(icol,:) = newstate(:) sati_ptr(icol, :) = satice(:) satl_ptr(icol, :) = satliq(:) end do - + ! Get the results for temperature. call CARMASTATE_GetState(cstate, rc, t=newstate(:)) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetState failed.') - + ! Store the values needed for substepping in the physics buffer. t_ptr(icol,:) = newstate(:) - if (carma_do_thermo) then + if (carma_do_thermo) then ptend%s(icol, :) = (newstate(:) - state_loc%t(icol, :)) * cpair / dt endif - - + + ! Get the substepping statistics if (carma_do_substep) then call CARMASTATE_Get(cstate, rc, zsubsteps=zsubsteps) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') - + spdiags(icol, :, SPDIAGS_NSTEP) = zsubsteps(:) spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) end if end do - - + + ! Report substep diagnostics if (carma_do_substep) then call CARMASTATE_Get(cstate, rc, max_nsubstep=max_nsubstep, max_nretry=max_nretry, & @@ -1576,27 +1507,27 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli !$OMP CRITICAL step_max_nsubstep = max(step_max_nsubstep, real(max_nsubstep, f)) step_max_nretry = max(step_max_nretry, max_nretry) - + step_nstep = step_nstep + nstep step_nsubstep = step_nsubstep + real(nsubstep, f) step_nretry = step_nretry + nretry !$OMP END CRITICAL end if - + ! The CARMASTATE object is no longer needed. call CARMASTATE_Destroy(cstate, rc) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Destroy failed.') - - + + ! Output diagnostic fields. call carma_output_diagnostics(state_loc, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) end subroutine carma_timestep_tend - - + + subroutine carma_accumulate_stats() implicit none - + integer :: istat integer :: rc real(kind=f) :: wrk @@ -1604,7 +1535,7 @@ subroutine carma_accumulate_stats() logical :: do_print ! do print output? ! Define formats - 1 format(' carma: max nsubstep=',1F9.0,3x,'avg nsubstep=',1F9.2,3x,'max nretry=',1F9.0,3x,'avg nretry=',1F10.4) + 1 format(' carma: max nsubstep=',1F9.0,3x,'avg nsubstep=',1F9.2,3x,'max nretry=',1F9.0,3x,'avg nretry=',1F10.4) if (carma_do_substep) then @@ -1619,7 +1550,7 @@ subroutine carma_accumulate_stats() end if step_max_nsubstep = wrk glob_max_nsubstep = max(glob_max_nsubstep, wrk) - + call mpi_allreduce(step_max_nretry, wrk, 1, mpir8, mpi_max, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for max_nsubstep failed; error = ',istat @@ -1627,7 +1558,7 @@ subroutine carma_accumulate_stats() end if step_max_nretry = wrk glob_max_nretry = max(glob_max_nretry, wrk) - + call mpi_allreduce(step_nstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nstep failed; error = ',istat @@ -1635,7 +1566,7 @@ subroutine carma_accumulate_stats() end if step_nstep = wrk glob_nstep = glob_nstep + wrk - + call mpi_allreduce(step_nsubstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nsubstep failed; error = ',istat @@ -1643,7 +1574,7 @@ subroutine carma_accumulate_stats() end if step_nsubstep = wrk glob_nsubstep = glob_nsubstep + wrk - + call mpi_allreduce(step_nretry, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nretry failed; error = ',istat @@ -1659,7 +1590,7 @@ subroutine carma_accumulate_stats() glob_nstep = glob_nstep + step_nstep glob_nsubstep = glob_nsubstep + step_nsubstep glob_nretry = glob_nretry + step_nretry - + #endif if (masterproc) then @@ -1695,7 +1626,7 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) logical, intent(in) :: mask(:) !! Only initialize where .true. real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) - + integer :: igroup ! group index integer :: ielem ! element index integer :: ilev ! level index @@ -1707,27 +1638,27 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) ! Initialize the return code. rc = 0 - + ! Determine the element an bin for the particle do ielem = 1, NELEM do ibin = 1, NBIN - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + if (cnst_name(icnst) == name) then - + ! By default, initialize all constituents to 0. do ilev = 1, size(q, 2) where(mask) @@ -1742,10 +1673,10 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) end if end do end do - + ! NOTE: There is currently no initialization for gases, but it could be ! added here. - + return end subroutine carma_init_cnst @@ -1762,11 +1693,11 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd type(physics_state), intent(in) :: state !! Physics state variables - before CARMA type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies - real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output - real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output - real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output - real(r8), intent(in), dimension(pcols, pver, NSPDIAGS) :: spdiags !! CARMA step diagnostic output - real(r8), intent(in), dimension(pcols, pver, NBIN, NELEM, NBNDIAGS) :: bndiags !! CARMA bin diagnostic output + real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output + real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output + real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output + real(r8), intent(in), dimension(pcols, pver, NSPDIAGS) :: spdiags !! CARMA step diagnostic output + real(r8), intent(in), dimension(pcols, pver, NBIN, NELEM, NBNDIAGS) :: bndiags !! CARMA bin diagnostic output ! Local variables integer :: igroup ! group index @@ -1783,46 +1714,46 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd integer :: maxbin ! last prognostic bin logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? - + ! Initialize the return code. rc = 0 - + ! Check each column int the chunk. lchnk = state%lchnk ncol = state%ncol ! Output step diagnostics. if (carma_do_substep) then - call outfld('CRNSTEP', spdiags(:, :, SPDIAGS_NSTEP), pcols, lchnk) - call outfld('CRLNSTEP', spdiags(:, :, SPDIAGS_LNSTEP), pcols, lchnk) + call outfld('CRNSTEP', spdiags(:, :, SPDIAGS_NSTEP), pcols, lchnk) + call outfld('CRLNSTEP', spdiags(:, :, SPDIAGS_LNSTEP), pcols, lchnk) end if ! Output the particle tendencies. do ielem = 1, NELEM do ibin = 1, NBIN - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - - call outfld(trim(etndname(ielem, ibin))//'TC', ptend%q(:, :, icnst), pcols, lchnk) + + call outfld(trim(etndname(ielem, ibin))//'TC', ptend%q(:, :, icnst), pcols, lchnk) if (do_drydep) then call outfld(trim(etndname(ielem, ibin))//'DD', sbdiags(:, ibin, ielem, SBDIAGS_DD), pcols, lchnk) end if if (carma_do_pheat) then - + ! Only specified for the number density element of the group. if (bndiags(1, 1, ibin, ielem, BNDIAGS_TP) /= CAM_FILL) then call outfld(trim(etndname(ielem, ibin))//'TP', bndiags(:, :, ibin, ielem, BNDIAGS_TP), pcols, lchnk) @@ -1832,56 +1763,56 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd end if end do end do - + ! Output the particle diagnostics. - do igroup = 1, NGROUP + do igroup = 1, NGROUP call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ienconc=ienconc) if (rc < 0) call endrun('carma_output_diagnostics::CARMAGROUP_Get failed.') - + ! Gridbox average - call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) - call outfld(trim(sname)//'AD', gpdiags(:, :, igroup, GPDIAGS_AD), pcols, lchnk) - call outfld(trim(sname)//'MD', gpdiags(:, :, igroup, GPDIAGS_MD), pcols, lchnk) - call outfld(trim(sname)//'RE', gpdiags(:, :, igroup, GPDIAGS_RE), pcols, lchnk) - call outfld(trim(sname)//'RM', gpdiags(:, :, igroup, GPDIAGS_RM), pcols, lchnk) - call outfld(trim(sname)//'JN', gpdiags(:, :, igroup, GPDIAGS_JN), pcols, lchnk) - call outfld(trim(sname)//'MR', gpdiags(:, :, igroup, GPDIAGS_MR), pcols, lchnk) - call outfld(trim(sname)//'EX', gpdiags(:, :, igroup, GPDIAGS_EX), pcols, lchnk) - call outfld(trim(sname)//'OD', gpdiags(:, :, igroup, GPDIAGS_OD), pcols, lchnk) - call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) - call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) - call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) - + call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) + call outfld(trim(sname)//'AD', gpdiags(:, :, igroup, GPDIAGS_AD), pcols, lchnk) + call outfld(trim(sname)//'MD', gpdiags(:, :, igroup, GPDIAGS_MD), pcols, lchnk) + call outfld(trim(sname)//'RE', gpdiags(:, :, igroup, GPDIAGS_RE), pcols, lchnk) + call outfld(trim(sname)//'RM', gpdiags(:, :, igroup, GPDIAGS_RM), pcols, lchnk) + call outfld(trim(sname)//'JN', gpdiags(:, :, igroup, GPDIAGS_JN), pcols, lchnk) + call outfld(trim(sname)//'MR', gpdiags(:, :, igroup, GPDIAGS_MR), pcols, lchnk) + call outfld(trim(sname)//'EX', gpdiags(:, :, igroup, GPDIAGS_EX), pcols, lchnk) + call outfld(trim(sname)//'OD', gpdiags(:, :, igroup, GPDIAGS_OD), pcols, lchnk) + call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) + call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) + call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) + if (do_drydep) then do ibin = 1, NBIN call outfld(trim(btndname(igroup, ibin))//'VD', sbdiags(:, ibin, ienconc, SBDIAGS_VD), pcols, lchnk) end do end if end do - + ! Output the gas tendencies. do igas = 1, NGAS icnst = icnst4gas(igas) - - call outfld(gtndname(igas), ptend%q(:, :, icnst), pcols, lchnk) - + + call outfld(gtndname(igas), ptend%q(:, :, icnst), pcols, lchnk) + ! Output the supersaturations. - call outfld(trim(cnst_name(icnst))//'SI', gsdiags(:, :, igas, GSDIAGS_SI), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'SL', gsdiags(:, :, igas, GSDIAGS_SL), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'EI', gsdiags(:, :, igas, GSDIAGS_EI), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'EL', gsdiags(:, :, igas, GSDIAGS_EL), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'WT', gsdiags(:, :, igas, GSDIAGS_WT), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'SI', gsdiags(:, :, igas, GSDIAGS_SI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'SL', gsdiags(:, :, igas, GSDIAGS_SL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EI', gsdiags(:, :, igas, GSDIAGS_EI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EL', gsdiags(:, :, igas, GSDIAGS_EL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'WT', gsdiags(:, :, igas, GSDIAGS_WT), pcols, lchnk) end do - + ! Output the temperature tendency. if (carma_do_thermo) then - call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) + call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) end if - + return end subroutine carma_output_diagnostics - - + + !! Calculate the emissions for CARMA aerosols. This is taken from !! the routine aerosol_emis_intr in aerosol_intr.F90 and dust_emis_intr in !! dust_intr.F90 by Phil Rasch. @@ -1893,7 +1824,7 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) use camsrfexch, only: cam_in_t implicit none - + type(physics_state), intent(in ) :: state !! physics state type(physics_ptend), intent(inout) :: ptend !! physics state tendencies type(cam_in_t), intent(inout) :: cam_in !! surface inputs @@ -1901,7 +1832,6 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk - integer :: icol ! column index integer :: igroup ! group index integer :: ielem ! element index integer :: ibin ! bin index @@ -1923,34 +1853,34 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) ncol = state%ncol lchnk = state%lchnk - + ! Provide emissions rates for particles. ! ! NOTE: This can only be done for prognostic groups. do ielem = 1, NELEM call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_drydep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_drydep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + do ibin = 1, NBIN ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + call CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) if (rc < 0) call endrun('carma_emission_tend::CARMA_EmitParticle failed.') - + ! Add any surface flux here. cam_in%cflx(:ncol, icnst) = surfaceFlux(:ncol) call outfld(trim(cnst_name(icnst))//'SF', cam_in%cflx(:ncol, icnst), ncol, lchnk) - + ! For emissions into the atmosphere, put the emission here. ptend%q(:ncol, :pver, icnst) = tendency(:ncol, :pver) call outfld(trim(cnst_name(icnst))//'EM', ptend%q(:ncol, :, icnst), ncol, lchnk) @@ -1958,18 +1888,18 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) enddo end if enddo - + ! No emissions rate is set up for gases, but it could be added here. return - end subroutine carma_emission_tend + end subroutine carma_emission_tend !! Calculate the wet deposition for the CARMA aerosols. This is taken from !! the routine aerosol_wet_int in aerosol_intr.F90 and dust_wet_intr in !! dust_intr.F90 by Phil Rasch. - !! - !! Method: + !! + !! Method: !! Use a modified version of the scavenging parameterization described in !! Barth et al, 2000, JGR (sulfur cycle paper) !! Rasch et al, 2001, JGR (INDOEX paper) @@ -1983,7 +1913,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) use wetdep, only: clddiag, wetdepa_v1, wetdepa_v2 use camsrfexch, only: cam_out_t use physconst, only: gravit - + implicit none real(r8), intent(in) :: dt !! time step (s) @@ -1997,14 +1927,11 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing wet chem and scavenging real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area, top interface of current layer - real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area, top interface of current layer + real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area, top interface of current layer integer :: ielem ! element index integer :: igroup ! group index integer :: ibin ! bin index integer :: icnst ! constituent index - integer :: lat(pcols) ! latitude indices - real(r8) :: clat(pcols) ! latitudes - integer :: lon(pcols) ! longtitude indices real(r8) :: conicw(pcols,pver) ! convective in-cloud water real(r8) :: cmfdqr(pcols,pver) ! convective production of rain real(r8) :: cldc(pcols,pver) ! convective cloud fraction, currently empty @@ -2027,8 +1954,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) real(r8) :: sflx(pcols) ! Surface Flux (kg/m2/s) integer :: maxbin - ! physics buffer - integer itim_old, ifld + ! physics buffer + integer itim_old real(r8), pointer, dimension(:,:) :: cldn ! cloud fraction real(r8), pointer, dimension(:,:) :: cme real(r8), pointer, dimension(:,:) :: prain @@ -2045,19 +1972,19 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! Initialize the return code. rc = 0 - + ! Initialize the output tendency structure. call physics_ptend_init(ptend,state%psetcols, 'CARMA (wetdep)', lq=lq_carma) if (.not. carma_flag) return - if (.not. carma_do_wetdep) return + if (.not. carma_do_wetdep) return ncol = state%ncol lchnk = state%lchnk ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() - + call pbuf_get_field(pbuf, pbuf_get_index('CLD'), cldn, (/1,1,itim_old/),(/pcols,pver,1/)) call pbuf_get_field(pbuf, pbuf_get_index('QME'), cme ) call pbuf_get_field(pbuf, pbuf_get_index('PRAIN'), prain ) @@ -2076,14 +2003,14 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) call pbuf_get_field(pbuf, pbuf_get_index('DP_FRAC'), dp_frac ) call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_SHCU'), evapcsh ) call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_DPCU'), evapcdp ) - + cldc(:ncol,:) = dp_frac(:ncol,:) + sh_frac(:ncol,:) ! Sungsu included this. evapc(:ncol,:) = evapcsh(:ncol,:) + evapcdp(:ncol,:) ! Sungsu included this. clds(:ncol,:) = cldn(:ncol,:) - cldc(:ncol,:) ! Stratiform cloud fraction cmfdqr(:ncol,:) = rprddp(:ncol,:) + rprdsh(:ncol,:) - + ! fields needed for wet scavenging call clddiag( state%t, state%pmid, state%pdel, cmfdqr, evapc, cldn, cldc, clds, cme, evapr, prain, & cldv, cldvcu, cldvst, rainmr, ncol ) @@ -2096,33 +2023,33 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! Iterate over each particle and calculate a tendency from wet ! scavenging for it. do ielem = 1, NELEM - + ! NOTE: This can only be done for prognistic groups. - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, & solfac=solfac, scavcoef=scavcoef, maxbin=maxbin) if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.') - + if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then - + do ibin = 1, NBIN - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + scavt = 0._r8 - + ! The scavenging coefficient might be calculated as a function of ! the aerosol bin at each grid point. However, for now, we will just ! use a constant value for each group. z_scavcoef(:, :) = scavcoef - + if (cam_physpkg_is('cam5') .or. cam_physpkg_is('cam6')) then call wetdepa_v2( & @@ -2138,20 +2065,20 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) cme, & evapr, & totcond, & - state%q(:, :, icnst), & + state%q(:, :, icnst), & dt, & scavt, & iscavt, & cldvcu, & cldvst, & - dlf, & - fracis(:, :, icnst), & + dlf, & + fracis(:, :, icnst), & solfac, & ncol, & z_scavcoef) - + else if (cam_physpkg_is('cam4')) then - + call wetdepa_v1(state%t, & state%pmid, & state%q, & @@ -2164,20 +2091,20 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) cme, & evapr, & totcond, & - state%q(:, :, icnst), & + state%q(:, :, icnst), & dt, & scavt, & iscavt, & cldv, & - fracis(:, :, icnst), & + fracis(:, :, icnst), & solfac, & ncol, & z_scavcoef) else - + call endrun('carma_wetdep_tend:: No wet deposition routine is available for this configuration.') end if - + ptend%q(:, :, icnst) = scavt call outfld(trim(cnst_name(icnst))//'WD', ptend%q(:, :, icnst), pcols, lchnk) @@ -2185,7 +2112,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! ptend%q(kg/kg air/s) * pdel(Pa) / gravit (m/s2) => (kg/m2/s) ! note: 1Pa = 1 kg air * (m/s2) / m2 sflx(:) = 0._r8 - + do k = 1,pver sflx(:ncol) = sflx(:ncol) - ptend%q(:ncol, k, icnst) * state%pdel(:ncol,k) / gravit enddo @@ -2194,7 +2121,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! Add this to the surface amount of the constituent call CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) - + end if end do end if @@ -2202,8 +2129,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) return end subroutine carma_wetdep_tend - - + + !! This routine creates files containing optical properties for each radiatively !! active particle type. These optical properties are used by the RRTMG radiation !! code to include the impact of CARMA particles in the radiative transfer @@ -2216,7 +2143,7 @@ subroutine CARMA_CreateOpticsFile(carma, rc) use radconstants, only : nswbands, nlwbands use wrap_nf use wetr, only : getwetr - + implicit none type(carma_type), intent(inout) :: carma !! the carma object @@ -2238,16 +2165,16 @@ subroutine CARMA_CreateOpticsFile(carma, rc) integer :: rhvar, lwvar, swvar integer :: abs_lw_var integer :: ext_sw_var, ssa_sw_var, asm_sw_var - integer :: omdim, andim, namedim - integer :: omvar, anvar, namevar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar integer :: dimids(2) integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar real(kind=f) :: abs_lw(NMIE_RH, nlwbands) real(kind=f) :: ext_sw(NMIE_RH, nswbands) real(kind=f) :: ssa_sw(NMIE_RH, nswbands) real(kind=f) :: asm_sw(NMIE_RH, nswbands) - character(len=8) :: c_name ! constituent name - character(len=32) :: aer_name ! long enough for both aername and name + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name character(len=255) :: filepath real(kind=f) :: rwet real(kind=f) :: Qext @@ -2261,55 +2188,55 @@ subroutine CARMA_CreateOpticsFile(carma, rc) integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? integer :: ret - - + + ! Assume success. rc = 0 - + ! Get the wavelength structure. call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') - + ! Process each group that is defined in the model. do igroup = 1, NGROUP - + ! Get the necessary group properties. call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & rlow=rlow, rup=rup, rmass=rmass, refidx=refidx, irhswell=irhswell, & ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') - + ! Are we supposed to do the mie calculation for this group? if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then - + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho) if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') - + ! A file needs to be created for each bin. do ibin = 1, NBIN - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + write(c_name, '(A, I2.2)') trim(shortname), ibin - + ! Construct the path to the file. Each model will have its own subdirectory ! where the optical property files are stored. filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' - + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) - + ! Create the file. call wrap_create(filepath, NF90_CLOBBER, fid) - + ! For non-hygroscopic, only use 1 RH value. if (irhswell /= 0) then nrh = NMIE_RH else nrh = min(NMIE_RH, 1) end if - + ! Define the dimensions: rh, lwbands, swbands call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) @@ -2319,23 +2246,23 @@ subroutine CARMA_CreateOpticsFile(carma, rc) dimids(1) = rhdim call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) - + dimids(1) = lwdim call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) - + dimids(1) = swdim call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." - - call wrap_put_att_text(fid, rhvar, 'units', 'fraction') - call wrap_put_att_text(fid, lwvar, 'units', 'm') - call wrap_put_att_text(fid, swvar, 'units', 'm') - + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') - + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw dimids(1) = rhdim dimids(2) = lwdim @@ -2343,61 +2270,61 @@ subroutine CARMA_CreateOpticsFile(carma, rc) write(LUNOPRT,*) "Defined abs_lw." - call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') - + call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') + dimids(1) = rhdim dimids(2) = swdim call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) - + write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." - call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') - call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') - call wrap_put_att_text(fid, asm_sw_var, 'units', '-') - + call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_var, 'units', '-') + ! Define the variables for the refractive indicies. dimids(1) = swdim call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) - + write(LUNOPRT,*) "Defined lw refindex." dimids(1) = lwdim call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) - + write(LUNOPRT,*) "Defined sw refindex." - call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') - - call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') - call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') - - + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + ! Define fields that define the aerosol properties. call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) dimids(1) = omdim call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) - + write(LUNOPRT,*) "Defined omdim." call wrap_def_dim(fid, 'namelength', 20, andim) dimids(1) = andim call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) - + write(LUNOPRT,*) "Defined aername." call wrap_def_dim(fid, 'name_len', 32, namedim) dimids(1) = namedim call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) - + write(LUNOPRT,*) "Defined name." call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) @@ -2407,42 +2334,42 @@ subroutine CARMA_CreateOpticsFile(carma, rc) call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) - - call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') - call wrap_put_att_text(fid, slogvar, 'units', '-') - call wrap_put_att_text(fid, dryrvar, 'units', 'm') - call wrap_put_att_text(fid, rminvar, 'units', 'm') - call wrap_put_att_text(fid, rmaxvar, 'units', 'm') - call wrap_put_att_text(fid, hygrovar, 'units', '-') - call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') - - call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') - call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') - call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') - call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') - call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') - call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') - call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') - - + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + write(LUNOPRT,*) "Defined all variables." - ! End the defintion phase of the netcdf file. + ! End the defintion phase of the netcdf file. call wrap_enddef(fid) - - + + ! Write out the dimensions. call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) - + ! Write out the refractive indicies. call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:))) call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:))) call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands))) call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands))) - - + + ! Pad the names out with spaces. aer_name = ' ' aer_name(1:len(trim(c_name))) = c_name @@ -2452,7 +2379,7 @@ subroutine CARMA_CreateOpticsFile(carma, rc) call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) count_text(1) = 20 call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) - + ! These fields control whether the particle is treated as a CCN. For now, ! set these so that CARMA particles are not considered as CCN by the ! CAM microphysics. @@ -2463,7 +2390,7 @@ subroutine CARMA_CreateOpticsFile(carma, rc) count_text(1) = len('insoluble ') call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) end if - + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) @@ -2471,20 +2398,20 @@ subroutine CARMA_CreateOpticsFile(carma, rc) call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) - + ! Iterate over a range of relative humidities, since the particle may swell ! with relative humidity which will change its optical properties. do irh = 1, nrh - + ! Determine the wet radius. call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') - + ! Calculate at each wavelength. do iwave = 1, NWAVE write(carma%f_LUNOPRT,*) "CARMA mie calc: start ", igroup, ibin, iwave, carma%f_wave(iwave), carma%f_group(igroup)%f_nmon(ibin) - + ! Using Mie code, calculate the optical properties: extinction coefficient, ! single scattering albedo and asymmetry factor. ! Assume the particle is homogeneous (no core). @@ -2505,18 +2432,18 @@ subroutine CARMA_CreateOpticsFile(carma, rc) rc) if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') write(carma%f_LUNOPRT,*) "CARMA mie calc: done ", Qext, Qsca, asym - - + + ! Calculate the shortwave and longwave properties? ! ! NOTE: miess is in cgs units, but the optics file needs to be in mks ! units, so perform the necessary conversions. if (iwave <= nlwbands) then - + ! Longwave just needs absorption: abs_lw. abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) else - + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: ! ext_sw, ssa_sw and asm_sw. ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) @@ -2525,14 +2452,14 @@ subroutine CARMA_CreateOpticsFile(carma, rc) end if end do end do - + ! Write out the longwave fields. ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) if (ret/=NF90_NOERR) then write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var call handle_error (ret) end if - + ! Write out the shortwave fields. ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) if (ret/=NF90_NOERR) then @@ -2549,23 +2476,23 @@ subroutine CARMA_CreateOpticsFile(carma, rc) write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var call handle_error (ret) end if - + ! Close the file. call wrap_close(fid) - end if + end if end do end if end do - + return - end subroutine CARMA_CreateOpticsFile - - + end subroutine CARMA_CreateOpticsFile + + !! This routine creates a file containing a reference temperature profile !! for use with fixed initialization. subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4) use wrap_nf - + implicit none type(carma_type), intent(inout) :: carma !! the carma object @@ -2581,54 +2508,54 @@ subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4 integer :: levdim integer :: levvar, tvar, h2ovar, h2so4var integer :: dimids(2) - - + + ! Assume success. rc = 0 - + ! Create the file. call wrap_create(filepath, NF90_CLOBBER, fid) - - + + ! Define the dimensions: lev call wrap_def_dim(fid, 'lev', pver, levdim) - + dimids(1) = levdim call wrap_def_var(fid, 'lev', NF90_DOUBLE, 1, dimids(1:1), levvar) - call wrap_put_att_text(fid, levvar, 'units', 'level') - call wrap_put_att_text(fid, levvar, 'long_name', 'hybrid level at midpoints (1000*(A+B))') - call wrap_put_att_text(fid, levvar, 'positive', 'down') - call wrap_put_att_text(fid, levvar, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate') - call wrap_put_att_text(fid, levvar, 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS') - + call wrap_put_att_text(fid, levvar, 'units', 'level') + call wrap_put_att_text(fid, levvar, 'long_name', 'hybrid level at midpoints (1000*(A+B))') + call wrap_put_att_text(fid, levvar, 'positive', 'down') + call wrap_put_att_text(fid, levvar, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate') + call wrap_put_att_text(fid, levvar, 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS') + ! Define the variables: T call wrap_def_var(fid, 'T', NF90_DOUBLE, 1, dimids(1:1), tvar) - - call wrap_put_att_text(fid, tvar, 'units', 'K') + + call wrap_put_att_text(fid, tvar, 'units', 'K') call wrap_put_att_text(fid, tvar, 'long_name', 'Temperature') - + if ((carma%f_igash2o /= 0) .and. present(refh2o)) then call wrap_def_var(fid, 'Q', NF90_DOUBLE, 1, dimids(1:1), h2ovar) - - call wrap_put_att_text(fid, h2ovar, 'units', 'kg/kg') + + call wrap_put_att_text(fid, h2ovar, 'units', 'kg/kg') call wrap_put_att_text(fid, h2ovar, 'long_name', 'Specific Humidity') end if if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then call wrap_def_var(fid, 'H2SO4', NF90_DOUBLE, 1, dimids(1:1), h2so4var) - - call wrap_put_att_text(fid, h2so4var, 'units', 'kg/kg') + + call wrap_put_att_text(fid, h2so4var, 'units', 'kg/kg') call wrap_put_att_text(fid, h2so4var, 'long_name', 'H2SO4') end if - - ! End the defintion phase of the netcdf file. + + ! End the defintion phase of the netcdf file. call wrap_enddef(fid) - - + + ! Write out the dimensions. call wrap_put_var_realx(fid, levvar, lev) - + ! Write out the variables. call wrap_put_var_realx(fid, tvar, reft) @@ -2639,14 +2566,14 @@ subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4 if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then call wrap_put_var_realx(fid, h2so4var, refh2so4(:)) end if - + ! Close the file. call wrap_close(fid) - + return end subroutine CARMA_CreateRefTFile - - + + !! Calculate the aerodynamic resistance for dry deposition. !! !! This is based upon Seinfeld and Pandis (1998) page 963, and @@ -2657,10 +2584,10 @@ end subroutine CARMA_CreateRefTFile !! @author Tianyi Fan !! @version Aug 2011 subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) - use shr_const_mod, only: shr_const_karman + use shr_const_mod, only: shr_const_karman use physconst, only: rair, gravit - implicit none + implicit none ! input and output argument real(r8), intent(in) :: ustar ! friction velocity @@ -2670,31 +2597,31 @@ subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) real(r8), intent(in) :: tmid ! layer mid-point temperature [K] real(r8), intent(in) :: obklen ! Monin-Obukhov length real(r8), intent(out) :: ram ! aerodynamic resistance - + ! local varibles real(r8) :: z ! half the layer height real(r8) :: psi ! stability parameter for z real(r8) :: psi0 ! stability parameter for z0 - real(r8) :: nu ! temparory variable + real(r8) :: nu ! temparory variable real(r8) :: nu0 ! temparory variable real(r8), parameter :: xkar = shr_const_karman - - + + ! Use half the layer height like Ganzefeld and Lelieveld, 1995 z = pdel * rair * tmid / pmid / gravit / 2._r8 - + if (obklen .eq. 0._r8) then psi = 0._r8 psi0 = 0._r8 else psi = min(max(z / obklen, -1._r8), 1._r8) - psi0 = min(max(z0 / obklen, -1._r8), 1._r8) + psi0 = min(max(z0 / obklen, -1._r8), 1._r8) endif - + ! Stable if (psi > 0._r8) then ram = 1._r8 / xkar / ustar * (log(z / z0) + 4.7_r8 * (psi - psi0)) - + ! Unstable else if (psi < 0._r8) then nu = (1._r8 - 15._r8 *psi)**(.25_r8) @@ -2708,12 +2635,12 @@ subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) else ram = 0._r8 end if - + ! Neutral else ram = 1._r8 / xkar / ustar * log(z / z0) end if - - return - end subroutine CARMA_calcram + + return + end subroutine CARMA_calcram end module carma_intr diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index 1d5bef3827..6d26848132 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -17,7 +17,7 @@ !! - WeibullWind() !! !! @version July-2012 -!! @author Lin Su, Pengfei Yu, Chuck Bardeen +!! @author Lin Su, Pengfei Yu, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -79,8 +79,8 @@ module carma_model_mod integer :: nClay !! Number of clay bins (r < 1 um) integer :: nSilt !! Number of silt bins - real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) - real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) contains @@ -88,27 +88,27 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su real(kind=f), parameter :: rmin = 1.19e-5_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.371_f ! volume ratio - + ! Default return code. - rc = RC_OK - + rc = RC_OK + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") - + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_soilerosion_file = ', carma_soilerosion_file @@ -124,24 +124,24 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, shortname="CRDUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes - + return end subroutine CARMA_DefineModel @@ -149,8 +149,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -169,22 +169,22 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step @@ -198,32 +198,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -234,20 +234,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -264,9 +264,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physics_types, only: physics_state use camsrfexch, only: cam_in_t use cam_history, only: outfld - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -277,15 +277,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat(pcols) ! latitude index + + integer :: ilat(pcols) ! latitude index integer :: ilon(pcols) ! longitude index integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk integer :: icol ! column index integer :: igroup ! the index of the carma aerosol group character(len=32) :: shortname ! the shortname of the group - + ! -------- local variables added for dust model ------------ real(r8), parameter :: ch = 0.5e-9_r8 ! dimensional factor & tuning number, ! as it's model resolution dependent (kgs^2/m^5)!!! @@ -294,10 +294,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8) :: uv10 ! 10 m wind speed (m/s) real(r8) :: cd10 ! 10-m drag coefficient () - real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: wwd ! raw wind speed (m/s) real(r8) :: sp ! mass fraction for soil factor integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay - + ! Default return code. rc = RC_OK @@ -307,21 +307,21 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 - + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r) if (RC < RC_ERROR) return - + if (shortname .eq. "CRDUST") then - + ! Is this clay or silt? ! ! NOTE: It is assumed that 90% of the mass will be silt and 10% will @@ -335,29 +335,30 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend idustbin = ibin else sp = 0.1_r8 / nClay - idustbin = nClay + 1 + idustbin = nClay + 1 end if ! Process each column. do icol = 1,ncol - - call CARMA_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + call CARMA_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) ! Is the wind above the threshold for dust production? if (uv10 > uth) then surfaceFlux(icol) = ch * soil_factor(icol, lchnk) * sp * & - wwd * (uv10 - uth) + wwd * (uv10 - uth) endif - - ! Scale the clay bins based upon the smallest silt bin. + + ! Scale the clay bins based upon the smallest silt bin. surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) - + end do ! For debug purposes, output the soil erosion factor. call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) - end if - + + end if + return end subroutine CARMA_EmitParticle @@ -387,8 +388,8 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) character(len=32) :: shortname ! the shortname of the element integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - - + + ! Default return code. rc = RC_OK @@ -397,15 +398,15 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! ! TBD: This should use the radii rather than being hard coded. ! nClay = 8 - ! nSilt = NBIN - nClay - do ielem = 1, NELEM + ! nSilt = NBIN - nClay + do ielem = 1, NELEM ! To get particle radius call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + if (shortname .eq. "CRDUST") then count_Silt = 0 do ibin = 1, NBIN @@ -413,27 +414,27 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) count_Silt = count_Silt + 1 else end if - end do + end do nSilt = count_Silt - nClay = NBIN - nSilt - end if + nClay = NBIN - nSilt + end if end do - + ! Read in the soil factors. call CARMA_ReadSoilErosionFactor(carma, rc) if (RC < RC_ERROR) return - + ! To determine Clay Mass Fraction - do ielem = 1, NELEM + do ielem = 1, NELEM ! To get particle radius call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) if (RC < RC_ERROR) return if (shortname .eq. "CRDUST") then - call CARMA_ClayMassFraction(carma, igroup, rc) - end if + call CARMA_ClayMassFraction(carma, igroup, rc) + end if end do - + if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") @@ -441,15 +442,15 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) then write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt - write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor - + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' end if end if - + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') - + return end subroutine CARMA_InitializeModel @@ -487,18 +488,18 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, return end subroutine CARMA_InitializeParticle - + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -506,14 +507,14 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition !! Determines the mass fraction for the clay (submicron) bins based upon @@ -526,49 +527,49 @@ end subroutine CARMA_WetDeposition !! NOTE: Should any mass go to bins smaller than the smallest one used by !! Tegen and Lacis? !! - !! @version July-2012 - !! @author Lin Su, Pengfei Yu, Chuck Bardeen + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen subroutine CARMA_ClayMassFraction(carma, igroup, rc) implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: igroup !! the carma group index integer, intent(inout) :: rc !! return code, negative indicates failure ! Bins and mass fraction from Tegen and Lacis. - integer, parameter :: NBIN_TEGEN = 4 + integer, parameter :: NBIN_TEGEN = 4 real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) ! Local Variables - integer, parameter :: IBELOW = 1 - integer, parameter :: IABOVE = 6 + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 integer :: tl_count(NBIN_TEGEN+2) ! count number in Tegen and Lacis ranges integer :: ind_up(NBIN_TEGEN+2) integer :: ind_low(NBIN_TEGEN+2) integer :: j ! local index number integer :: ibin ! carma bin index real(r8) :: r(carma%f_NBIN) ! CARMA bin center (cm) - + ! Default return code. rc = RC_OK - + ! Interpolate from Tegen and Lacis. call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis ! ranges. tl_count(:) = 0 - + do ibin = 1, NBIN - + ! Smaller than the range. if (r(ibin) < tl_rmin(1)) then tl_count(IBELOW) = tl_count(IBELOW) + 1 end if - + ! In the range do j = 1, NBIN_TEGEN if (r(ibin) < tl_rmax(j) .and. r(ibin) >= tl_rmin(j)) then @@ -579,7 +580,7 @@ subroutine CARMA_ClayMassFraction(carma, igroup, rc) ! Bigger than the range. if (r(ibin) >= tl_rmax(NBIN_TEGEN)) then tl_count(IABOVE) = tl_count(IABOVE) + 1 - end if + end if end do ! Determine where the boundaries are between the TEGEN bins and @@ -588,30 +589,30 @@ subroutine CARMA_ClayMassFraction(carma, igroup, rc) ind_low(:) = 0 ind_up (IBELOW) = tl_count(IBELOW) ind_low(IBELOW) = min(1, tl_count(IBELOW)) - + do j = 1, 5 ind_up (j+1) = ind_up(j) + tl_count(j+1) ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1) end do - + ! No mass to bins smaller than the smallest size. clay_mf(:) = 0._r8 - + ! NOTE: This won't work right if the dust bins are coarser than ! the Tegen and Lacis bins. In this case mass fraction would need - ! to be combined from the Tegen & Lacis bins into a CARMA bin. + ! to be combined from the Tegen & Lacis bins into a CARMA bin. do j = 1, NBIN_TEGEN if (tl_count(j+1) > 0) then clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1) end if - end do - + end do + clay_mf(ind_low(IABOVE):) = 1._r8 return end subroutine CARMA_ClayMassFraction - + !! Calculate the sea surface wind with a Weibull distribution. !! !! NOTE: This should be combined with a similar routine in the sea salt @@ -624,12 +625,12 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t - + implicit none ! in and out field type(carma_type), intent(in) :: carma !! the carma object - type(physics_state), intent(in) :: state !! physics state + type(physics_state), intent(in) :: state !! physics state integer, intent(in) :: icol !! column index integer, intent(in) :: ielem !! element index integer, intent(in) :: igroup !! group index @@ -643,12 +644,12 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv real(r8), parameter :: vk = 0.4_r8 ! von Karman constant real(r8) :: r(NBIN) ! CARMA bin center (cm) real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) - real(r8) :: uthfact ! + real(r8) :: uthfact ! integer :: iepart ! element in group containing the particle concentration real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface - + rc = RC_OK - + ! Get the 10 meter wind speed uv10 = cam_in%u10(icol) @@ -656,11 +657,11 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv ! note that in cgs units --> m/s call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + ! Define particle # concentration element index for current group call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) if (RC < RC_ERROR) return - + if (cam_in%soilw(icol) > 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then uthfact = 1.2_r8 + 0.2_r8*log10(cam_in%soilw(icol)) if (r(ibin) > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm @@ -674,7 +675,7 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv endif else uth = uv10 - endif + endif ! Use Weibull with Lansing's estimate for shape. call WeibullWind(uv10, uth, 2._r8, wwd) @@ -693,14 +694,13 @@ end subroutine CARMA_SurfaceWind !! @author Pengfei Yu !! @version July-2012 subroutine CARMA_ReadSoilErosionFactor(carma, rc) -! use physics_types, only: physics_state use pmgrid, only: plat, plon use ppgrid, only: begchunk, endchunk, pcols use ioFileMod, only: getfil use wrap_nf - use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish - use phys_grid, only: get_lon_all_p, get_lat_all_p, get_ncols_p - + use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only: get_rlon_all_p, get_rlat_all_p, get_ncols_p + implicit none type(carma_type), intent(in) :: carma !! the carma object @@ -713,31 +713,32 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) character(len=256) :: ero_file real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension - type (interp_type) :: wgt1, wgt2 - real(r8) :: lat(pcols) ! latitude index + type (interp_type) :: lat_wght, lon_wght + real(r8) :: lat(pcols) ! latitude index real(r8) :: lon(pcols) ! longitude index integer :: i, ii integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 + rc = RC_OK ! Open the netcdf file (read only) call getfil(carma_soilerosion_file, ero_file, 0) call wrap_open(ero_file, 0, fid) - + ! Get file dimensions call wrap_inq_dimid(fid, 'plon', fid_lon) call wrap_inq_dimid(fid, 'plat', fid_lat) call wrap_inq_dimlen(fid, fid_lon, f_nlon) call wrap_inq_dimlen(fid, fid_lat, f_nlat) - + allocate(ero_lat(f_nlat)) allocate(ero_lon(f_nlon)) allocate(ero_factor (f_nlon, f_nlat)) allocate(soil_factor(pcols, begchunk:endchunk)) - ! Read in the tables. call wrap_inq_varid(fid, 'new_source', idvar) i = nf90_get_var (fid, idvar, ero_factor) @@ -749,38 +750,39 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) call wrap_get_var_realx(fid, idlat, ero_lat) call wrap_inq_varid(fid, 'plon', idlon) call wrap_get_var_realx(fid, idlon, ero_lon) - + + ero_lat(:) = ero_lat(:)*degs2rads + ero_lon(:) = ero_lon(:)*degs2rads + ! Close the file. call wrap_close(fid) - - do lchnk=begchunk, endchunk - ncol = get_ncols_p(lchnk) - - call get_lat_all_p(lchnk, pcols, lat) - call get_lon_all_p(lchnk, pcols, lon) - - call lininterp_init(ero_lon, f_nlon, lon, ncol, 1, wgt2) - call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, wgt1) - - call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, wgt2, wgt1) - - call lininterp_finish(wgt1) - call lininterp_finish(wgt2) - end do - + + do lchnk=begchunk, endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + call lininterp_init(ero_lon, f_nlon, lon, ncol, 2, lon_wght, zero, twopi) + call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, lat_wght) + + call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, lon_wght, lat_wght) + + call lininterp_finish(lon_wght) + call lininterp_finish(lat_wght) + end do + deallocate(ero_lat) deallocate(ero_lon) deallocate(ero_factor) - - return end subroutine CARMA_ReadSoilErosionFactor !! Calculate the nth mean of u using Weibull wind distribution !! considering the threshold wind velocity. This algorithm !! integrates from uth to infinite (u^n P(u)du ) - !! + !! !! @author Tianyi Fan !! @version August-2010 subroutine WeibullWind(u, uth, n, uwb, wbk) @@ -789,33 +791,33 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) igamma => shr_spfn_igamma implicit none - + real(r8), intent(in) :: u ! mean wind speed real(r8), intent(in) :: uth ! threshold velocity real(r8), intent(in) :: n ! the rank of u in the integration real(r8), intent(out) :: uwb ! the Weibull distribution real(r8), intent(in), optional :: wbk ! the shape parameter - + ! local variable real(r8) :: k ! the shape parameter in Weibull distribution real(r8) :: c ! the scale parameter in Weibull distribution - + if (present(wbk)) then k = wbk else k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate - end if - + end if + ! If u is 0, then k can be 0, which makes a lot of this undefined. ! Just return 0. in this case. if (u == 0._r8) then uwb = 0._r8 - else - c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) end if end subroutine WeibullWind - + end module diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 index d60aa02bee..573d0bc968 100755 --- a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -14,8 +14,8 @@ !! preliminary. Please talk to Chuck Bardeen (bardeenc@ucar.edu) if you are !! interested in this model. !! -!! @version Oct-2012 -!! @author Chuck Bardeen +!! @version Oct-2012 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -50,7 +50,7 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups integer, public, parameter :: NELEM = 2 !! Number of particle elements @@ -64,7 +64,7 @@ module carma_model_mod !! humidities. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -81,8 +81,8 @@ module carma_model_mod integer, public, parameter :: I_ELEM_DUST = 1 !! dust aerosol element integer, public, parameter :: I_ELEM_SOOT = 2 !! soot aerosol element - - + + integer :: carma_dustmap(NBIN) !! mapping of the CARMA dust bins to the surface dust bins. real(kind=f) :: carma_dustbinfactor(NBIN) !! bin weighting factor for dust emissions real(kind=f) :: carma_sootbinfactor(NBIN) !! bin weighting factor for soot emissions @@ -94,12 +94,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f) :: RHO_SOOT ! density of soot particles (g/cm) @@ -121,16 +121,16 @@ subroutine CARMA_DefineModel(carma, rc) ! Adjust longitudes to be 0 to 360 rather than +- 180. if (carma_emis_minlon < 0._f) carma_emis_minlon = 360._f + carma_emis_minlon if (carma_emis_maxlon < 0._f) carma_emis_maxlon = 360._f + carma_emis_maxlon - + if (carma_emis_minlat > carma_emis_maxlat) then - if (do_print) write(LUNOPRT,*) 'CARMA_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' + if (do_print) write(LUNOPRT,*) 'CARMA_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' end if - + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_emis_dust = ', carma_emis_dust, ' (kg)' @@ -158,7 +158,7 @@ subroutine CARMA_DefineModel(carma, rc) ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the ! real part (0.003 (IR) to 0.05 (UV)). refidx(:) = (1.53_f, 0.008_f) - + call CARMAGROUP_Create(carma, I_GRP_DUST, "Dust", dust_rmin, dust_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="CRDUST", refidx=refidx, do_mie=.true.) @@ -167,7 +167,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Use the same refractive index at all wavelengths. This value is typical of soot and ! is recommended by Toon et al. 2012. refidx(:) = (1.8_f, 0.67_f) - + if (carma_fractal_soot) then RHO_SOOT = 1.8_f @@ -188,8 +188,8 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true.) end if if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -200,13 +200,13 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') @@ -221,8 +221,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -231,7 +231,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -241,27 +241,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -270,32 +270,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -306,14 +306,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + integer :: ielem ! element index integer :: ibin ! bin index real(r8) :: mmr(pver) ! mass mixing ration (kg/kg) @@ -327,19 +327,19 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! NOTE: Don't give the surface model negative values for the surface fluxes. ielem = I_ELEM_SOOT do ibin = 1, NBIN - + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') - + cam_out%bcphidry(icol) = cam_out%bcphidry(icol) + max(sflx, 0._r8) end do ielem = I_ELEM_DUST do ibin = 1, NBIN - + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') - + if (carma_dustmap(ibin) == 1) then cam_out%dstdry1(icol) = cam_out%dstdry1(icol) + max(sflx, 0._r8) else if (carma_dustmap(ibin) == 2) then @@ -350,7 +350,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, cam_out%dstdry4(icol) = cam_out%dstdry4(icol) + max(sflx, 0._r8) end if end do - + return end subroutine CARMA_DiagnoseBulk @@ -370,9 +370,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t use tropopause, only: tropopause_find use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -383,16 +383,16 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - + real(r8), parameter :: mu_dust_gnd = 1._r8 ! width parameter, dust, ground (km) real(r8), parameter :: mu_dust_trop = 3._r8 ! width parameter, dust, tropopause (km) real(r8), parameter :: mu_soot_gnd = 1._r8 ! width parameter, soot, ground (km) real(r8), parameter :: mu_soot_trop = 3._r8 ! width parameter, soot, tropopause (km) - integer :: tropLev(pcols) ! tropopause level index - real(r8) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8) :: tropT(pcols) ! tropopause temperature (K) - real(r8) :: tropZ(pcols) ! tropopause height (m) + integer :: tropLev(pcols) ! tropopause level index + real(r8) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8) :: tropT(pcols) ! tropopause temperature (K) + real(r8) :: tropZ(pcols) ! tropopause height (m) real(r8) :: lon(state%ncol) ! longitude real(r8) :: lat(state%ncol) ! latitude @@ -434,14 +434,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Determine the latitude and longitude of each column. ncol = state%ncol - + lat = state%lat(:ncol) * RAD2DEG lon = state%lon(:ncol) * RAD2DEG - - + + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! Use Toon et al. [2012] as the source function for soot and dust @@ -456,13 +456,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! NOTE: Perhaps some of these fields should end up in the CARMA ! model namelist, so different experiments can be run more easily. tendency(:ncol, :pver) = 0.0_r8 - + ! Determine the start and stop year and day of year from the namelist ! variables. currentDate = yr * 1000 + doy startyear = carma_emis_startdate / 1000 stopyear = carma_emis_stopdate / 1000 - + startdoy = mod(carma_emis_startdate, 1000) stopdoy = mod(carma_emis_stopdate, 1000) @@ -471,48 +471,48 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ((currentDate == carma_emis_startdate) .and. (ncsec >= carma_emis_starttime))) .and. & ((currentDate < carma_emis_stopdate) .or. & ((currentDate == carma_emis_stopdate) .and. (ncsec < carma_emis_stoptime)))) then - + ! Make sure to emit for at least one timestep and in multiples of the time ! step length. ! TBD - This has a leap year problem, but works otherwise ... carma_emis_dtime = INT((((stopyear - startyear) * 365._f + (stopdoy - startdoy)) * 24._f * 3600._f + & (carma_emis_stoptime - carma_emis_starttime)) / dt) * dt - + ! For simplicity, calculate the emission function at the cell midpoint and ! assume that rate is used throughout the cell. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname) if (RC < RC_ERROR) return - + if ((shortname == "CRDUST") .or. (shortname == "CRSOOT")) then ! Find the tropopause using the default algorithm backed by the climatology. call tropopause_find(state, tropLev, tropZ=tropZ) - + ! Loop over all of the columns. do icol = 1, ncol - + ! Is the column one of the ones over which there should be emissions> if ((lat(icol) > carma_emis_minlat) .and. (lat(icol) < carma_emis_maxlat) .and. & (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(icol) >= carma_emis_minlon) .and. & (lon(icol) <= carma_emis_maxlon)) .or. & ((carma_emis_minlon > carma_emis_maxlon) .and. & ((lon(icol) >= carma_emis_minlon) .or. (lon(icol) <= carma_emis_maxlon))))) then - + ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver - + ! Get the cell midpoint and height zmid = state%zm(icol, k) / 1000._f - + ! Get the tropopause height. ztrop = tropZ(icol) / 1000._f - - ! Use the dust emission from Toon et al. 2012. + + ! Use the dust emission from Toon et al. 2012. if (shortname == "CRDUST") then - + ! Determine the total emission rate for this grid box using equation 2 ! from Toon et al. [2012] and also adjust for the fraction of the ! mass that goes into the specified bin based on the assumed size @@ -521,13 +521,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend (1._f / mu_dust_gnd * exp(-0.5_f * ((zmid / mu_dust_gnd)**2)) + & 1._f / (2._f * mu_dust_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_dust_trop)**2))) * & (state%zi(icol, k) - state%zi(icol, k+1)) - + rate = carma_emis_dust * carma_dustbinfactor(ibin) end if - + ! Use the soot emissions from Toon et al. 2012. if (shortname == "CRSOOT") then - + ! Determine the total emission rate for this grid box using equation 2 ! from Toon et al. [2012] and also adjust for the fraction of the ! mass that goes into the specified bin based on the assumed size @@ -536,29 +536,29 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend (1._f / mu_soot_gnd * exp(-0.5_f * ((zmid / mu_soot_gnd)**2)) + & 1._f / (2._f * mu_soot_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_soot_trop)**2))) * & (state%zi(icol, k) - state%zi(icol, k+1)) - - + + rate = carma_emis_soot * carma_sootbinfactor(ibin) end if - + ! Calculate a rate by dividing by total emission time. rate = rate * vfunc(k) / carma_emis_dtime - + ! Scale for the fraction of the total surface area that is emitting and ! convert to kg/m2/s massflux = rate / carma_emis_area - + ! Convert the mass flux to a tendency on the mass mixing ratio. tendency(icol, k) = massflux / (state%pdel(icol, k) / gravit) end do - + ! Now normalize in the vertical to preserve the total mass. tendency(icol, :) = tendency(icol, :) / sum(vfunc(:)) end if end do end if end if - + return end subroutine CARMA_EmitParticle @@ -573,15 +573,18 @@ end subroutine CARMA_EmitParticle !! @version May-2009 subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only: pcnst - use dyn_grid, only: get_horiz_grid_dim_d, get_horiz_grid_d + use phys_grid, only: get_rlat_all_p, get_rlon_all_p, get_area_all_p, get_ncols_p + use shr_reprosum_mod, only: shr_reprosum_calc + use ppgrid, only: begchunk, endchunk + use spmd_utils, only: mpicom implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency integer, intent(out) :: rc !! return code, negative indicates failure - + ! NOTE: The dust distribution has not been specified yet, but it should be different ! from the soot. real(kind=f), parameter :: rm_dust = 0.11 ! dust mean radius (um) @@ -590,9 +593,6 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) real(kind=f), parameter :: sigma_soot = 1.6 ! soot variance integer :: i - integer :: hdim1_d - integer :: hdim2_d - integer :: ngcols real(kind=f) :: r(NBIN) real(kind=f) :: dr(NBIN) real(kind=f) :: rmass(NBIN) @@ -600,12 +600,16 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) real(kind=f), allocatable :: lat(:) real(kind=f), allocatable :: lon(:) real(kind=f), allocatable :: colarea(:) + real(kind=f), allocatable :: local_carma_emis_area(:,:) character(len=32) :: shortname ! the shortname of the group - + integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - 1 format(i3,5x,i3,4x,e10.3,4x,e10.3) + integer :: kk, lchnk, ncol + real(kind=f) :: wrk(1) + + 1 format(i3,5x,i3,4x,e10.3,4x,e10.3) ! Default return code. rc = RC_OK @@ -620,7 +624,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! 4 : 5.0 - 10.0 um call CARMAGROUP_GET(carma, I_GRP_DUST, rc, r=r) if (RC < RC_ERROR) return - + do i = 1, NBIN if (r(i) .le. 1e-4_f) then carma_dustmap(i) = 1 @@ -632,65 +636,73 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_dustmap(i) = 4 end if end do - + ! Determine the weight of mass in each bin based upon the size distribution specified ! in Toon et al. [2012], for soot and dust. They are lognormal for the smaller sizes ! and dust is lognormal for larger sizes. - + call CARMAGROUP_GET(carma, I_GRP_DUST, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + dM(:) = rmass(:) * & exp(-(log(r(:) * 1e4_f / rm_dust) ** 2) / (2._f * (log(sigma_dust) ** 2))) / & log(sigma_dust) * (dr(:) / r(:)) - carma_dustbinfactor(:) = dM / sum(dM) + carma_dustbinfactor(:) = dM / sum(dM) call CARMAGROUP_GET(carma, I_GRP_SOOT, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + dM(:) = rmass(:) * & exp(-(log(r(:) * 1e4_f / rm_soot) ** 2) / (2._f * (log(sigma_soot) ** 2))) / & log(sigma_soot) * (dr(:) / r(:)) carma_sootbinfactor(:) = dM / sum(dM) - + ! Determine the total area in which debris will be emitted. This is used to scale - ! the emission per column, based upon the fraction of surface area. This assumes a - ! regular physics grid. - call get_horiz_grid_dim_d(hdim1_d, hdim2_d) - - ngcols = hdim1_d*hdim2_d - - allocate(lat(ngcols)) - allocate(lon(ngcols)) - allocate(colarea(ngcols)) - - call get_horiz_grid_d(ngcols, clat_d_out=lat, clon_d_out=lon, area_d_out=colarea) - - lat = lat * RAD2DEG - lon = lon * RAD2DEG - - ! rad2 -> m2 - colarea = colarea * REARTH * REARTH / 1e4 + ! the emission per column, based upon the fraction of surface area. + + allocate(lat(pcols)) + allocate(lon(pcols)) + allocate(colarea(pcols)) + allocate(local_carma_emis_area(pcols,begchunk:endchunk)) + + local_carma_emis_area(:,:) = 0._r8 ! Integrate surface area with same checks as in the emission routine to determine ! the area where the emissions come from (m2). Assume that the grid box is either - ! all in or all out based upon the center lat/lon. Don't include fractions of a + ! all in or all out based upon the center lat/lon. Don't include fractions of a ! grid box. - carma_emis_area = 0._f - - do i = 1, ngcols - if ((lat(i) >= carma_emis_minlat) .and. (lat(i) <= carma_emis_maxlat) .and. & - (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(i) >= carma_emis_minlon) .and. & - (lon(i) <= carma_emis_maxlon)) .or. & - ((carma_emis_minlon > carma_emis_maxlon) .and. & - ((lon(i) >= carma_emis_minlon) .or. (lon(i) <= carma_emis_maxlon))))) then - carma_emis_area = carma_emis_area + colarea(i) - end if - end do - - carma_emis_area = carma_emis_area - + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + ! radians -> degrees + lat(:ncol) = lat(:ncol) * RAD2DEG + lon(:ncol) = lon(:ncol) * RAD2DEG + + call get_area_all_p(lchnk, pcols, colarea) + + ! rad2 -> m2 + colarea(:ncol) = colarea(:ncol) * REARTH * REARTH / 1.e4_r8 + + do i = 1,ncol + if ((lat(i) >= carma_emis_minlat) .and. (lat(i) <= carma_emis_maxlat) .and. & + (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(i) >= carma_emis_minlon) .and. & + (lon(i) <= carma_emis_maxlon)) .or. & + ((carma_emis_minlon > carma_emis_maxlon) .and. & + ((lon(i) >= carma_emis_minlon) .or. (lon(i) <= carma_emis_maxlon))))) then + local_carma_emis_area(i,lchnk) = colarea(i) + endif + enddo + enddo + + kk = pcols*(endchunk-begchunk+1) + call shr_reprosum_calc( local_carma_emis_area, wrk,kk,kk,1, commid=mpicom ) + + carma_emis_area = wrk(1) + deallocate(lat) deallocate(lon) deallocate(colarea) @@ -699,12 +711,12 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - - + + if (do_print) then write(LUNOPRT,*) '' write(LUNOPRT,*) 'CARMA Initialization ...' - + write(LUNOPRT,*) '' write(LUNOPRT,*) 'ibin dustmap dustfactor sootfactor' @@ -737,7 +749,7 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -751,21 +763,21 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, rc = RC_OK ! Add initial condition here. - + return end subroutine CARMA_InitializeParticle - + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -773,12 +785,12 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + ! Add the wet deposition fluxes to the hydrophilic black carbon. ! ! NOTE: Don't give the surface model negative values for the surface fluxes. @@ -801,8 +813,8 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) end if end do end if - + return - end subroutine CARMA_WetDeposition - + end subroutine CARMA_WetDeposition + end module diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 index d26452d58a..ec6293c5a7 100644 --- a/src/physics/carma/models/sea_salt/carma_model_mod.F90 +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -15,7 +15,7 @@ !! - WeibullWind() !! !! @version Dec-2010 -!! @author Tianyi Fan, Chuck Bardeen +!! @author Tianyi Fan, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -81,22 +81,22 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 4.32_f ! volume ratio - + ! Default return code. rc = RC_OK - + ! Report model specific configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) @@ -106,8 +106,8 @@ subroutine CARMA_DefineModel(carma, rc) if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_seasalt_emis = ', trim(carma_seasalt_emis) end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -119,23 +119,23 @@ subroutine CARMA_DefineModel(carma, rc) irhswcomp=I_SWG_SEA_SALT) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "sea salt", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes - + return end subroutine CARMA_DefineModel @@ -143,8 +143,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -163,22 +163,22 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step @@ -192,32 +192,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -228,20 +228,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -258,9 +258,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physics_types, only: physics_state use phys_grid, only: get_lon_all_p, get_lat_all_p use camsrfexch, only: cam_in_t - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -271,17 +271,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat(pcols) ! latitude index - integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk integer :: icol ! column index integer :: igroup ! the index of the carma aerosol group character(len=32) :: shortname ! the shortname of the group - + ! -------- local variables added for sea salt model ------------ - real(r8) :: rdrycm, rdry ! dry radius [cm], [um] + real(r8) :: rdrycm, rdry ! dry radius [cm], [um] real(r8) :: r80cm, r80 ! wet radius at relatige humidity of 80% [cm] real(r8) :: ncflx ! dF/dr [#/m2/s/um] real(r8) :: Monahan, Clarke, Smith ! dF/dr [#/m2/s/um] @@ -303,103 +301,103 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! ------------------------------------------------------------------------------------------------- real(r8), parameter :: c41 = -2.576e35_r8 real(r8), parameter :: c42 = -2.452e33_r8 - real(r8), parameter :: c43 = 1.085e29_r8 + real(r8), parameter :: c43 = 1.085e29_r8 real(r8), parameter :: c31 = 5.932e28_r8 real(r8), parameter :: c32 = 2.404e27_r8 - real(r8), parameter :: c33 = -9.841e23_r8 - real(r8), parameter :: c21 = -2.867e21_r8 - real(r8), parameter :: c22 = -8.148e20_r8 - real(r8), parameter :: c23 = 3.132e18_r8 + real(r8), parameter :: c33 = -9.841e23_r8 + real(r8), parameter :: c21 = -2.867e21_r8 + real(r8), parameter :: c22 = -8.148e20_r8 + real(r8), parameter :: c23 = 3.132e18_r8 real(r8), parameter :: c11 = -3.003e13_r8 - real(r8), parameter :: c12 = 1.183e14_r8 - real(r8), parameter :: c13 = -4.165e12_r8 + real(r8), parameter :: c12 = 1.183e14_r8 + real(r8), parameter :: c13 = -4.165e12_r8 real(r8), parameter :: c01 = -2.881e6_r8 real(r8), parameter :: c02 = -6.743e6_r8 - real(r8), parameter :: c03 = 2.181e6_r8 + real(r8), parameter :: c03 = 2.181e6_r8 real(r8), parameter :: d41 = 7.188e37_r8 real(r8), parameter :: d42 = 7.368e35_r8 - real(r8), parameter :: d43 = -2.859e31_r8 + real(r8), parameter :: d43 = -2.859e31_r8 real(r8), parameter :: d31 =-1.616e31_r8 real(r8), parameter :: d32 =-7.310e29_r8 - real(r8), parameter :: d33 = 2.601e26_r8 + real(r8), parameter :: d33 = 2.601e26_r8 real(r8), parameter :: d21 = 6.791e23_r8 real(r8), parameter :: d22 = 2.528e23_r8 - real(r8), parameter :: d23 =-8.297e20_r8 + real(r8), parameter :: d23 =-8.297e20_r8 real(r8), parameter :: d11 = 1.829e16_r8 real(r8), parameter :: d12 =-3.787e16_r8 - real(r8), parameter :: d13 = 1.105e15_r8 + real(r8), parameter :: d13 = 1.105e15_r8 real(r8), parameter :: d01 = 7.609e8_r8 real(r8), parameter :: d02 = 2.279e9_r8 real(r8), parameter :: d03 =-5.800e8_r8 - - real(r8) :: rpdry ! dry radius + + real(r8) :: rpdry ! dry radius real(r8) :: Ak1 ! Coefficient Ak in Martensson's source function - real(r8) :: Ak2 - real(r8) :: Ak3 + real(r8) :: Ak2 + real(r8) :: Ak3 real(r8) :: Bk1 ! Coefficient Bk in Martensson's source function real(r8) :: Bk2 real(r8) :: Bk3 Ak1(rpdry)= c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01 Ak2(rpdry)= c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02 - Ak3(rpdry)= c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 + Ak3(rpdry)= c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 Bk1(rpdry)= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01 Bk2(rpdry)= d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02 Bk3(rpdry)= d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03 - + ! ------------------------------------------------------------ ! ---- Clarke Source Function. Coefficients for Ai ------- ! ------------------------------------------------------------ real(r8), parameter :: beta01 =-5.001e3_r8 real(r8), parameter :: beta11 = 0.808e6_r8 - real(r8), parameter :: beta21 =-1.980e7_r8 + real(r8), parameter :: beta21 =-1.980e7_r8 real(r8), parameter :: beta31 = 2.188e8_r8 real(r8), parameter :: beta41 =-1.144e9_r8 - real(r8), parameter :: beta51 = 2.290e9_r8 + real(r8), parameter :: beta51 = 2.290e9_r8 real(r8), parameter :: beta02 = 3.854e3_r8 real(r8), parameter :: beta12 = 1.168e4_r8 real(r8), parameter :: beta22 =-6.572e4_r8 real(r8), parameter :: beta32 = 1.003e5_r8 real(r8), parameter :: beta42 =-6.407e4_r8 - real(r8), parameter :: beta52 = 1.493e4_r8 + real(r8), parameter :: beta52 = 1.493e4_r8 real(r8), parameter :: beta03 = 4.498e2_r8 real(r8), parameter :: beta13 = 0.839e3_r8 real(r8), parameter :: beta23 =-5.394e2_r8 real(r8), parameter :: beta33 = 1.218e2_r8 real(r8), parameter :: beta43 =-1.213e1_r8 - real(r8), parameter :: beta53 = 4.514e-1_r8 + real(r8), parameter :: beta53 = 4.514e-1_r8 real(r8) :: A1 ! Coefficient Ak in Clarkes's source function - real(r8) :: A2 - real(r8) :: A3 + real(r8) :: A2 + real(r8) :: A3 A1(rpdry) = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + & beta31*(2._r8*rpdry)**3 + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5 A2(rpdry) = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + & beta32*(2._r8*rpdry)**3 + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5 A3(rpdry) = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + & beta33*(2._r8*rpdry)**3 + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5 - + ! --------------------------------------------- ! coefficient A1, A2 in Andreas's Source funcion ! --------------------------------------------- - real(r8) ::A1A92 - real(r8) ::A2A92 - + real(r8) ::A1A92 + real(r8) ::A2A92 + ! --------------------------------------------- ! coefficient in Smith's Source funcion - ! --------------------------------------------- - real(r8), parameter :: f1 = 3.1_r8 + ! --------------------------------------------- + real(r8), parameter :: f1 = 3.1_r8 real(r8), parameter :: f2 = 3.3_r8 real(r8), parameter :: r1 = 2.1_r8 real(r8), parameter :: r2 = 9.2_r8 real(r8), parameter :: delta = 10._r8 - + + ! -------------------------------------------------------------------- + ! ---- constants in calculating the particle wet radius [Gerber, 1985] ! -------------------------------------------------------------------- - ! ---- constants in calculating the particle wet radius [Gerber, 1985] - ! -------------------------------------------------------------------- real(r8), parameter :: c1 = 0.7674_r8 ! . real(r8), parameter :: c2 = 3.079_r8 ! . real(r8), parameter :: c3 = 2.573e-11_r8 ! . real(r8), parameter :: c4 = -1.424_r8 ! constants in calculating the particel wet radius - + ! Default return code. rc = RC_OK @@ -407,25 +405,22 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend lchnk = state%lchnk ncol = state%ncol - call get_lat_all_p(lchnk, ncol, ilat) - call get_lon_all_p(lchnk, ncol, ilon) - ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 - - + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + if (shortname .eq. "SALT") then ! Are we configured for one of the known emission schemes? @@ -437,174 +432,174 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend carma_seasalt_emis .ne. "CMS" .and. & carma_seasalt_emis .ne. "NONE" .and. & carma_seasalt_emis .ne. "CONST" ) then - + call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.') end if - + + !********************************** + ! wet sea salt radius at RH = 80% !********************************** - ! wet sea salt radius at RH = 80% - !********************************** r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8)) + (r(ibin))**3) ** (1./3.) ! [cm] - rdrycm = r(ibin) ! [cm] + rdrycm = r(ibin) ! [cm] r80 = r80cm *1.e4_r8 ! [um] rdry = rdrycm*1.e4_r8 ! [um] - + do icol = 1,ncol - + ! Only generate sea salt over the ocean. if (cam_in%ocnfrac(icol) > 0._r8) then - + !********************************** ! WIND for seasalt production - !********************************** - call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), cam_in, u10in, rc) - - ! Add any surface flux here. + !********************************** + call CARMA_SurfaceWind(carma, state, icol, cam_in, u10in, rc) + + ! Add any surface flux here. ncflx = 0.0_r8 - Monahan = 0.0_r8 + Monahan = 0.0_r8 Clarke = 0.0_r8 - Smith = 0.0_r8 - + Smith = 0.0_r8 + !********************************** ! Whitecap Coverage !********************************** wcap = 3.84e-6_r8 * u10in ** 3.41_r8 ! in percent, ie., 75%, wcap = 0.75 - + !**************************************** ! Hoppel correction factor ! Smith drag coefficients and etc !**************************************** if (u10in .le. 10._r8) then - cd_smith = 1.14e-3_r8 + cd_smith = 1.14e-3_r8 else cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8 end if - + ustar_smith = cd_smith **0.5_r8 * u10in - + ! We don't have vg yet, since that is calculated by CARMA. That will require ! a different interface for the emissions, storing vg in the physics buffer, ! and/or doing some duplicate calculations for vg assuming 80% RH. ! fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith)) fref = 1.0_r8 - + !********************************** ! Source Functions !********************************** if (carma_seasalt_emis .eq. 'NONE') then ncflx = 0._r8 end if - + if (carma_seasalt_emis .eq. 'CONST') then ncflx = 1.e-5_r8 end if - + !-------Gong source function------ - if (carma_seasalt_emis == "Gong") then - sita_para = 30 + if (carma_seasalt_emis == "Gong") then + sita_para = 30 A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8)) - B_para = (0.433_r8 - log10(r80)) / 0.433_r8 + B_para = (0.433_r8 - log10(r80)) / 0.433_r8 ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * & (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2)) ! if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in end if - + !------Martensson source function----- - if (carma_seasalt_emis == "Martensson") then + if (carma_seasalt_emis == "Martensson") then if (rdry .le. 0.0725_r8) then ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] - ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then + elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] - ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - else + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else ncflx = 0._r8 end if end if - - !-------Clarke source function------- - if (carma_seasalt_emis == "Clarke")then + + !-------Clarke source function------- + if (carma_seasalt_emis == "Clarke")then if (rdry .lt. 0.066_r8) then - ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then - ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then + ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then - ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then + ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx= ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] else ncflx = 0._r8 - end if + end if end if - + !-----------Caffrey source function------------ - if (carma_seasalt_emis == "Caffrey") then - - !Monahan + if (carma_seasalt_emis == "Caffrey") then + + !Monahan B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * & (1._r8 + 0.057 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1. * B_mona**2)) ! dF/dr - + !Smith u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) - A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2) ! dF/dr [#/m2/s/um] - + !Caffrey based on Monahan and Smith - W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) + W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) if (rdry .lt. 0.15_r8) then ncflx = Monahan - else + else if (u10in .le. 9._r8) then - ncflx = Monahan + ncflx = Monahan else if(Monahan .ge. Smith) then - ncflx = Monahan + ncflx = Monahan else - ncflx = Smith + ncflx = Smith end if end if end if - + ncflx = ncflx * W_Caff - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! Apply Hoppel correction !%%%%%%%%%%%%%%%%%%%%%%%%% - ncflx = ncflx * fref + ncflx = ncflx * fref end if !--------CMS (Clarke, Monahan, and Smith source function)------- - if (carma_seasalt_emis == "CMS") then - - !Clarke + if (carma_seasalt_emis == "CMS") then + + !Clarke if (rdry .lt. 0.066_r8) then - Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then - Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then + Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then - Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then + Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke= Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - end if - - !Monahan - B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 + end if + + !Monahan + B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * & (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2)) - + !Smith u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8)) ! 14 meter wind A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) - A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2) ! dF/dr [#/m2/s/um] - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! CMS1 or CMS2 !%%%%%%%%%%%%%%%%%%%%%%%%% @@ -613,8 +608,8 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if (rdry .lt. 1._r8) then ! cut at 1.0 um ! ***CMS2***** ! if (rdry .lt. 2._r8) then ! cut at 2.0 um - ncflx = Clarke - else + ncflx = Clarke + else if (u10in .lt. 9._r8) then ncflx = Monahan else @@ -625,14 +620,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end if end if - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! Apply Hoppel correction - !%%%%%%%%%%%%%%%%%%%%%%%%% - ncflx = ncflx * fref + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref end if - ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] + ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] surfaceFlux(icol) = ncflx * dr(ibin) * rmass(ibin) * 10._r8 ! *1e4[um/cm] * 1.e-3[kg/g] ! if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup @@ -640,11 +635,11 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", surfaceFlux = ", surfaceFlux(icol) ! weighted by the ocean fraction - surfaceFlux(icol) = surfaceFlux(icol) * cam_in%ocnfrac(icol) + surfaceFlux(icol) = surfaceFlux(icol) * cam_in%ocnfrac(icol) end if end do end if - + return end subroutine CARMA_EmitParticle @@ -667,7 +662,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) rc = RC_OK ! Add initialization here. - + return end subroutine CARMA_InitializeModel @@ -705,18 +700,18 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, return end subroutine CARMA_InitializeParticle - + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -724,37 +719,35 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition !! Calculate the sea surface wind with a Weibull distribution. !! !! @author Tianyi Fan !! @version August-2010 - subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) + subroutine CARMA_SurfaceWind(carma, state, icol, cam_in, u10in, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t - + implicit none ! in and out field type(carma_type), intent(in) :: carma !! the carma object type(physics_state), intent(in) :: state !! physics state integer, intent(in) :: icol !! column index - integer, intent(in) :: ilat !! latitude index - integer, intent(in) :: ilon !! longitude index type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: u10in !! the 10m wind speed put into the source function integer, intent(out) :: rc !! return code, negative indicates failure - + ! local variables ! the nth mean wind with integration using Weibull Distribution (integrate from threshold wind velocity) real(r8) :: uWB341 @@ -763,9 +756,9 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) uWB341 = 0._r8 - ! calc. the Weibull wind distribution + ! calc. the Weibull wind distribution u10in = cam_in%u10(icol) - + call WeibullWind(u10in, uth, 3.41_r8, uWB341) ! Asked for 3.41 moment of the wind, but return the first moment of the @@ -779,7 +772,7 @@ end subroutine CARMA_SurfaceWind !! Calculate the nth mean of u using Weibull wind distribution !! considering the threshold wind velocity. This algorithm !! integrates from uth to infinite (u^n P(u)du ) - !! + !! !! @author Tianyi Fan !! @version August-2010 subroutine WeibullWind(u, uth, n, uwb, wbk) @@ -788,30 +781,30 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) igamma => shr_spfn_igamma implicit none - + real(r8), intent(in) :: u ! mean wind speed real(r8), intent(in) :: uth ! threshold velocity real(r8), intent(in) :: n ! the rank of u in the integration real(r8), intent(out) :: uwb ! the Weibull distribution real(r8), intent(in), optional :: wbk ! the shape parameter - + ! local variable real(r8) :: k ! the shape parameter in Weibull distribution real(r8) :: c ! the scale parameter in Weibull distribution - + if (present(wbk)) then k = wbk else k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate - end if - + end if + ! At some locations the k parameter is 0, not ocean which then ! makes the gamma functions unstable. - if (k .eq. 0._r8) then + if (k .eq. 0._r8) then c = u**n else - c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) end if From 919195a27557fa56301c531e6af21c47a3581f9d Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 8 Aug 2022 09:09:23 -0600 Subject: [PATCH 03/14] add izumi_nag carma tests --- cime_config/testdefs/testlist_cam.xml | 65 +++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 4202a170a0..0938877a2d 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -781,6 +781,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From b9e321d16f90e69c44002f3aa10a281ab80c4bea Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 17 Aug 2022 15:34:49 -0600 Subject: [PATCH 04/14] add cheyenne tests --- cime_config/testdefs/testlist_cam.xml | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 0938877a2d..33f10e5fc7 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -649,6 +649,15 @@ + + + + + + + + + @@ -781,7 +790,7 @@ - + @@ -790,61 +799,73 @@ + + + + + + + + + + + + From 2ef2070a4d5057f4b2dcea5d4b7611c08b81a1ec Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 18 Aug 2022 09:56:39 -0600 Subject: [PATCH 05/14] ignore fixedinit issues with SE dycore; revert carma_get profile routines modified: cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam modified: src/physics/carma/cam/carma_getH2O.F90 modified: src/physics/carma/cam/carma_getH2SO4.F90 modified: src/physics/carma/cam/carma_getT.F90 --- .../testmods_dirs/cam/carma_pmc/user_nl_cam | 2 +- src/physics/carma/cam/carma_getH2O.F90 | 40 ++++++++----------- src/physics/carma/cam/carma_getH2SO4.F90 | 34 ++++++---------- src/physics/carma/cam/carma_getT.F90 | 34 ++++++---------- 4 files changed, 43 insertions(+), 67 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam index 3f4d9cf0b3..b40ad17f97 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam @@ -4,6 +4,6 @@ nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' pbuf_global_allocate=.false. history_carma=.true. -carma_do_fixedinit=.true. +carma_do_fixedinit=.false. carma_do_partialinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/src/physics/carma/cam/carma_getH2O.F90 b/src/physics/carma/cam/carma_getH2O.F90 index 050644a1b2..436042d6f6 100644 --- a/src/physics/carma/cam/carma_getH2O.F90 +++ b/src/physics/carma/cam/carma_getH2O.F90 @@ -2,14 +2,13 @@ ! ! NOTE: This needs to be in its own file to avoid circular references. subroutine carma_getH2O(h2o) - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_initfiles, only: initial_file_get_id - use pio, only: file_desc_t - use ppgrid, only: pcols, pver, begchunk, endchunk - use cam_abortutils, only: endrun - use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names - use ncdio_atm, only: infld - use gmean_mod, only: gmean + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_initfiles, only: initial_file_get_id + use pio, only: file_desc_t + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp + use cam_abortutils, only: endrun real(r8), intent(out) :: h2o(pver) ! midpoint h2o mmr (kg/kg) @@ -17,32 +16,25 @@ subroutine carma_getH2O(h2o) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_h2o(:,:,:) - integer :: grid_id - character(len=4) :: dim1name, dim2name - character(len=*), parameter :: subname = 'carma_getH2O' ! For an initial run, if the file is missing, then create one using the ! average concentration from the initial condition file. ncid_ini => initial_file_get_id() + nullify(init_h2o) - allocate(init_h2o(pcols,pver,begchunk:endchunk)) - - grid_id = cam_grid_id('physgrid') - if (.not. cam_grid_check(grid_id)) then - call endrun(subname//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - call infld('Q', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_h2o, found, gridname='physgrid') - + allocate(init_h2o(plon,pver,plat)) + call cam_pio_get_var('Q', ncid_ini, init_h2o, found=found) + if (.not. found) then - call endrun(subname//': failed to find field Q in IC file.') + call endrun('carma_init::cam_pio_get_var failed to find field Q.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - call gmean(init_h2o(:, iz, :), h2o(iz)) + h2o(iz) = sum(init_h2o(:, iz, :)) / plat / plon end do deallocate(init_h2o) - - end subroutine carma_getH2O + + return + end diff --git a/src/physics/carma/cam/carma_getH2SO4.F90 b/src/physics/carma/cam/carma_getH2SO4.F90 index 0b1c47d93d..0472656529 100644 --- a/src/physics/carma/cam/carma_getH2SO4.F90 +++ b/src/physics/carma/cam/carma_getH2SO4.F90 @@ -5,11 +5,10 @@ subroutine carma_getH2SO4(h2so4) use shr_kind_mod, only: r8 => shr_kind_r8 use cam_initfiles, only: initial_file_get_id use pio, only: file_desc_t - use ppgrid, only: pcols, pver, begchunk, endchunk + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp use cam_abortutils, only: endrun - use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names - use ncdio_atm, only: infld - use gmean_mod, only: gmean real(r8), intent(out) :: h2so4(pver) ! midpoint h2so4 mmr (kg/kg) @@ -17,32 +16,25 @@ subroutine carma_getH2SO4(h2so4) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_h2so4(:,:,:) - integer :: grid_id - character(len=4) :: dim1name, dim2name - character(len=*), parameter :: subname = 'carma_getH2SO4' ! For an initial run, if the file is missing, then create one using the ! average concentration from the initial condition file. - ncid_ini => initial_file_get_id() - - allocate(init_h2so4(pcols,pver,begchunk:endchunk)) - - grid_id = cam_grid_id('physgrid') - if (.not. cam_grid_check(grid_id)) then - call endrun(subname//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - call infld('H2SO4', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_h2so4, found, gridname='physgrid') + ncid_ini => initial_file_get_id() + nullify(init_h2so4) + allocate(init_h2so4(plon,pver,plat)) + call cam_pio_get_var('H2SO4', ncid_ini, init_h2so4, found=found) + if (.not. found) then - call endrun(subname//': failed to find field H2SO4 in IC file.') + call endrun('carma_init::cam_pio_get_var failed to find field H2SO4.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - call gmean(init_h2so4(:, iz, :), h2so4(iz)) + h2so4(iz) = sum(init_h2so4(:, iz, :)) / plat / plon end do deallocate(init_h2so4) - - end subroutine carma_getH2SO4 + + return + end diff --git a/src/physics/carma/cam/carma_getT.F90 b/src/physics/carma/cam/carma_getT.F90 index ab3ccae28e..27bf928b98 100644 --- a/src/physics/carma/cam/carma_getT.F90 +++ b/src/physics/carma/cam/carma_getT.F90 @@ -5,11 +5,10 @@ subroutine carma_getT(T) use shr_kind_mod, only: r8 => shr_kind_r8 use cam_initfiles, only: initial_file_get_id use pio, only: file_desc_t - use ppgrid, only: pcols, pver, begchunk, endchunk + use cam_pio_utils, only: cam_pio_get_var + use pmgrid, only: plat, plev, plevp, plon + use ppgrid, only: pcols, pver, pverp use cam_abortutils, only: endrun - use cam_grid_support, only: cam_grid_check, cam_grid_id, cam_grid_get_dim_names - use ncdio_atm, only: infld - use gmean_mod, only: gmean real(r8), intent(out) :: T(pver) ! midpoint temperature (Pa) @@ -17,32 +16,25 @@ subroutine carma_getT(T) type(file_desc_t), pointer :: ncid_ini logical :: found real(r8), pointer :: init_t(:,:,:) - integer :: grid_id - character(len=4) :: dim1name, dim2name - character(len=*), parameter :: subname = 'carma_getT' ! For an initial run, if the file is missing, then create one using the average ! temperature from the initial condition file. - ncid_ini => initial_file_get_id() - - allocate(init_t(pcols,pver,begchunk:endchunk)) - - grid_id = cam_grid_id('physgrid') - if (.not. cam_grid_check(grid_id)) then - call endrun(subname//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - call infld('T', ncid_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, init_t, found, gridname='physgrid') + ncid_ini => initial_file_get_id() + nullify(init_t) + allocate(init_t(plon,pver,plat)) + call cam_pio_get_var('T', ncid_ini, init_t, found=found) + if (.not. found) then - call endrun(subname//': failed to find field T in IC file.') + call endrun('carma_init::cam_pio_get_var failed to find field T.') end if ! Just do a simple average. Could get gw and do a weighted average. do iz = 1, pver - call gmean(init_t(:, iz, :), T(iz)) + T(iz) = sum(init_t(:, iz, :)) / plat / plon end do deallocate(init_t) - - end subroutine carma_getT + + return + end From 4550b55237fc72d7fa4756afc08617beaacbabf3 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 12 Oct 2022 16:46:11 -0600 Subject: [PATCH 06/14] use carma base tag carma4_01; misc cleanup modified: Externals_CAM.cfg modified: src/physics/carma/models/dust/carma_model_mod.F90 modified: src/physics/carma/models/meteor_impact/carma_model_mod.F90 modified: src/physics/carma/models/meteor_smoke/carma_model_mod.F90 modified: src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 modified: src/physics/carma/models/pmc/carma_model_mod.F90 modified: src/physics/carma/models/sea_salt/carma_model_mod.F90 modified: src/physics/carma/models/sulfate/carma_model_mod.F90 modified: src/physics/carma/models/test_growth/carma_model_mod.F90 modified: src/physics/carma/models/test_passive/carma_model_mod.F90 modified: src/physics/carma/models/test_radiative/carma_model_mod.F90 modified: src/physics/carma/models/test_swelling/carma_model_mod.F90 modified: src/physics/carma/models/test_tracers/carma_model_mod.F90 modified: src/physics/carma/models/test_tracers2/carma_model_mod.F90 --- Externals_CAM.cfg | 4 +- .../carma/models/dust/carma_model_mod.F90 | 1 - .../models/meteor_impact/carma_model_mod.F90 | 1 - .../models/meteor_smoke/carma_model_mod.F90 | 183 ++++++++------- .../models/mixed_sulfate/carma_model_mod.F90 | 1 - .../carma/models/pmc/carma_model_mod.F90 | 219 +++++++++--------- .../carma/models/sea_salt/carma_model_mod.F90 | 1 - .../carma/models/sulfate/carma_model_mod.F90 | 97 ++++---- .../models/test_growth/carma_model_mod.F90 | 134 +++++------ .../models/test_passive/carma_model_mod.F90 | 118 +++++----- .../models/test_radiative/carma_model_mod.F90 | 114 ++++----- .../models/test_swelling/carma_model_mod.F90 | 116 +++++----- .../models/test_tracers/carma_model_mod.F90 | 157 +++++++------ .../models/test_tracers2/carma_model_mod.F90 | 157 +++++++------ 14 files changed, 647 insertions(+), 656 deletions(-) diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 9606088b4d..d85629a67b 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -8,8 +8,8 @@ required = True [carma] local_path = src/physics/carma/base protocol = git -repo_url = https://github.com/fvitt/CARMA_base.git -branch = unstructured_grids +repo_url = https://github.com/ESCOMP/CARMA_base.git +tag = carma4_01 required = True [cosp2] diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index 6d26848132..22ba9b69d2 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -694,7 +694,6 @@ end subroutine CARMA_SurfaceWind !! @author Pengfei Yu !! @version July-2012 subroutine CARMA_ReadSoilErosionFactor(carma, rc) - use pmgrid, only: plat, plon use ppgrid, only: begchunk, endchunk, pcols use ioFileMod, only: getfil use wrap_nf diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 index 573d0bc968..717ca7bb06 100755 --- a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -746,7 +746,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none diff --git a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 index 5bc4787ad5..0b6d83aba1 100644 --- a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 @@ -9,7 +9,7 @@ !! - CARMA_InitializeModel() !! !! @version Jan-2011 -!! @author Chuck Bardeen +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -35,7 +35,7 @@ module carma_model_mod #if ( defined SPMD ) use mpishorthand -#endif +#endif implicit none @@ -81,9 +81,9 @@ module carma_model_mod integer :: carma_emis_nLevs ! number of emission levels real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) - integer :: carma_emis_ilev_min ! index of minimum level in table - integer :: carma_emis_ilev_max ! index of maximum level in table - integer :: carma_emis_ilev_incr ! index increment to increase level + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) integer :: carma_escale_nLats ! number of emission scale latitudes @@ -100,12 +100,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) @@ -113,15 +113,15 @@ subroutine CARMA_DefineModel(carma, rc) integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - + ! Default return code. rc = RC_OK - + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale @@ -129,8 +129,8 @@ subroutine CARMA_DefineModel(carma, rc) if (do_print) write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) if (do_print) write(LUNOPRT,*) ' carma_escale_file= ', trim(carma_escale_file) end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -141,7 +141,7 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, shortname="DUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -149,18 +149,18 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') - + return end subroutine CARMA_DefineModel @@ -168,8 +168,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -188,22 +188,22 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step @@ -217,32 +217,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -253,20 +253,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -284,9 +284,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -297,8 +297,8 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat ! latitude index + + integer :: ilat ! latitude index integer :: iltime ! local time index integer :: ncol ! number of columns in chunk integer :: icol ! column index @@ -322,7 +322,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend integer :: ncdate real(r8) :: ltime ! local time - + ! Default return code. rc = RC_OK @@ -343,33 +343,33 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 ! Only do emission for the first bin of the meteor smoke group. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + ! For meteoritic dust, the source from the smoke only goes into the ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates ! is proportional to the pressure, so the emission is a function of - ! pressure. + ! pressure. if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver do icol = 1, ncol - + pressure = state%pmid(icol, k) - + ! This is roughly a log-normal approximation to the production ! rate, but only applies from about 70 to 110 km. ! @@ -386,32 +386,32 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! surrounding the pressure and do a linear interpolation on the ! rate. This linear search is kind of expensive, particularly if ! there are a lot of points. - ! + ! ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then rate = carma_emis_rate(ilev) - + if (pressure > carma_emis_lev(ilev)) then rate = rate + & ((carma_emis_rate(ilev+carma_emis_ilev_incr) - & carma_emis_rate(ilev)) / (carma_emis_lev(ilev+carma_emis_ilev_incr) - & carma_emis_lev(ilev))) * (pressure - carma_emis_lev(ilev)) end if - + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) exit end if end do - + ! Calculate the mass flux in terms of kg/m3/s massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) - + ! Calculate a scaling if appropriate. rfScale(icol) = 1.0_r8 - + if (carma_do_escale) then - + ! Global Scaling ! ! Interpolate the global scale by latitude. @@ -438,7 +438,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if - + ! Local Time Scaling ! ! Interpolate the local scale by local time. @@ -460,10 +460,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do endif - + ! Convert the mass flux to a tendency on the mass mixing ratio. thickness = state%zi(icol, k) - state%zi(icol, k+1) - tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) end if enddo enddo @@ -473,13 +473,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend do icol = 1, ncol columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) scale = carma_emis_expected / columnMass - + ! Also apply the relative flux scaling. This needs to be done after ! the normalization tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) end do end if - + return end subroutine CARMA_EmitParticle @@ -525,9 +525,9 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + ! Initialize the emissions rate table. - if (carma_do_emission) then + if (carma_do_emission) then if (masterproc) then ! Open the netcdf file (read only) @@ -540,7 +540,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "lev", lev_did) call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) endif - + #if ( defined SPMD ) call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) #endif @@ -568,7 +568,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (carma_emis_rate(ilev) <= 0.0) then carma_emis_ilev_min = ilev + 1 else - exit + exit endif end do @@ -576,7 +576,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (carma_emis_rate(ilev) <= 0.0) then carma_emis_ilev_max = ilev - 1 else - exit + exit endif end do @@ -586,21 +586,21 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_incr = -1 tmp = carma_emis_ilev_min carma_emis_ilev_min = carma_emis_ilev_max - carma_emis_iLev_max = tmp + carma_emis_iLev_max = tmp endif if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) enddo - + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) @@ -620,10 +620,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + ! Initialize the emissions scaling table. - if (carma_do_escale) then + if (carma_do_escale) then if (masterproc) then ! Open the netcdf file (read only) @@ -638,17 +638,17 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "time", time_did) call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) - + ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif - + call wrap_inq_dimid(fid, "ltime", ltime_did) call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) endif - + #if ( defined SPMD ) call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) @@ -677,7 +677,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'ltime', ltime_vid) call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) - + ! Close the file. call wrap_close(fid) @@ -686,7 +686,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' endif @@ -699,7 +699,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + return end subroutine CARMA_InitializeModel @@ -715,7 +715,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none @@ -737,18 +736,18 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -756,13 +755,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 index 803a37edd6..36ee1be358 100644 --- a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 @@ -794,7 +794,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none diff --git a/src/physics/carma/models/pmc/carma_model_mod.F90 b/src/physics/carma/models/pmc/carma_model_mod.F90 index 1ddd1b1347..eb8c6e6667 100644 --- a/src/physics/carma/models/pmc/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc/carma_model_mod.F90 @@ -12,7 +12,7 @@ !! !! !! @version Jan-2011 -!! @author Chuck Bardeen +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -38,7 +38,7 @@ module carma_model_mod #if ( defined SPMD ) use mpishorthand -#endif +#endif implicit none @@ -91,9 +91,9 @@ module carma_model_mod integer :: carma_emis_nLevs ! number of emission levels real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) - integer :: carma_emis_ilev_min ! index of minimum level in table - integer :: carma_emis_ilev_max ! index of maximum level in table - integer :: carma_emis_ilev_incr ! index increment to increase level + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) integer :: carma_escale_nLats ! number of emission scale latitudes @@ -115,15 +115,15 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) use ioFileMod, only: getfil use wrap_nf type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) @@ -137,16 +137,16 @@ subroutine CARMA_DefineModel(carma, rc) integer :: imag_vid character(len=256) :: efile ! refractive index file name real(kind=f) :: interp - complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -158,8 +158,8 @@ subroutine CARMA_DefineModel(carma, rc) write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) end if end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -168,59 +168,59 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - + ! Get the refractive index for ice as a function of wavelength for particle heating ! calculations. ! ! NOTE: These values probably should be a band average, but for now just do band centers. - + ! Read the values in from Warren et al. 2008. if (carma_do_pheat) then - if (masterproc) then - + if (masterproc) then + ! Open the netcdf file (read only) call getfil(carma_mice_file, efile, fid) if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile - + call wrap_open(efile, 0, fid) - + ! Alocate the table arrays call wrap_inq_dimid(fid, "wavelength", wave_did) call wrap_inq_dimlen(fid, wave_did, warren_nwave) endif - + #if ( defined SPMD ) call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) #endif - + allocate(warren_wave(warren_nwave)) allocate(warren_real(warren_nwave)) allocate(warren_imag(warren_nwave)) - + if (masterproc) then - + ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) warren_wave = warren_wave * 1e-4 ! um -> cm - + call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) - + call wrap_inq_varid(fid, 'm_imag', imag_vid) call wrap_get_var_realx(fid, imag_vid, warren_imag) - + ! Close the file. call wrap_close(fid) end if - + #if ( defined SPMD ) call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) #endif - + ! Interpolate the values. do i = 1, NWAVE do j = 1, warren_nwave @@ -232,18 +232,18 @@ subroutine CARMA_DefineModel(carma, rc) else refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) endif - + exit end if end do end do end if - + call CARMAGROUP_Create(carma, I_GRP_CRICE, "ice crystal", rmin, 2.2_f, I_SPHERE, 1._f, .true., & rc, do_mie=carma_do_pheat, refidx=refidx_ice, shortname="CRICE") if (rc < 0) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -259,17 +259,17 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "ice core", RHO_METEOR_SMOKE, & I_COREMASS, I_METEOR_SMOKE, rc, shortname="CRCORE") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + + ! Define the Solutes - - + + ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=0.2_f) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - - + + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') @@ -283,7 +283,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_CRICE, I_GRP_CRICE, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') - + return end subroutine CARMA_DefineModel @@ -291,8 +291,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -311,22 +311,22 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step @@ -340,32 +340,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -376,20 +376,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -401,9 +401,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -414,8 +414,8 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat ! latitude index + + integer :: ilat ! latitude index integer :: iltime ! local time index integer :: ncol ! number of columns in chunk integer :: icol ! column index @@ -439,7 +439,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend integer :: ncdate real(r8) :: ltime ! local time - + ! Default return code. rc = RC_OK @@ -460,33 +460,33 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 ! Only do emission for the first bin of the meteor smoke group. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + ! For meteoritic dust, the source from the smoke only goes into the ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates ! is proportional to the pressure, so the emission is a function of - ! pressure. + ! pressure. if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver do icol = 1, ncol - + pressure = state%pmid(icol, k) - + ! This is roughly a log-normal approximation to the production ! rate, but only applies from about 70 to 110 km. ! @@ -503,32 +503,32 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! surrounding the pressure and do a linear interpolation on the ! rate. This linear search is kind of expensive, particularly if ! there are a lot of points. - ! + ! ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then rate = carma_emis_rate(ilev) - + if (pressure > carma_emis_lev(ilev)) then rate = rate + & ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & (pressure - carma_emis_lev(ilev)) end if - + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) exit end if end do - + ! Calculate the mass flux in terms of kg/m3/s massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) - + ! Calculate a scaling if appropriate. rfScale(icol) = 1.0_r8 - + if (carma_do_escale) then - + ! Global Scaling ! ! Interpolate the global scale by latitude. @@ -555,7 +555,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if - + ! Local Time Scaling ! ! Interpolate the local scale by local time. @@ -577,10 +577,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do endif - + ! Convert the mass flux to a tendency on the mass mixing ratio. thickness = state%zi(icol, k) - state%zi(icol, k+1) - tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) end if enddo enddo @@ -590,13 +590,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend do icol = 1, ncol columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) scale = carma_emis_expected / columnMass - + ! Also apply the relative flux scaling. This needs to be done after ! the normalization tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) end do end if - + return end subroutine CARMA_EmitParticle @@ -642,9 +642,9 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + ! Initialize the emissions rate table. - if (carma_do_emission) then + if (carma_do_emission) then if (masterproc) then ! Open the netcdf file (read only) @@ -657,7 +657,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "lev", lev_did) call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) endif - + #if ( defined SPMD ) call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) #endif @@ -685,7 +685,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (carma_emis_rate(ilev) <= 0.0) then carma_emis_ilev_min = ilev + 1 else - exit + exit endif end do @@ -693,7 +693,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (carma_emis_rate(ilev) <= 0.0) then carma_emis_ilev_max = ilev - 1 else - exit + exit endif end do @@ -703,21 +703,21 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_incr = -1 tmp = carma_emis_ilev_min carma_emis_ilev_min = carma_emis_ilev_max - carma_emis_iLev_max = tmp + carma_emis_iLev_max = tmp endif if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) enddo - + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) @@ -737,10 +737,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + ! Initialize the emissions scaling table. - if (carma_do_escale) then + if (carma_do_escale) then if (masterproc) then ! Open the netcdf file (read only) @@ -755,17 +755,17 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "time", time_did) call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) - + ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif - + call wrap_inq_dimid(fid, "ltime", ltime_did) call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) endif - + #if ( defined SPMD ) call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) @@ -794,7 +794,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'ltime', ltime_vid) call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) - + ! Close the file. call wrap_close(fid) @@ -803,7 +803,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' endif @@ -816,7 +816,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + return end subroutine CARMA_InitializeModel @@ -832,7 +832,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none @@ -854,18 +853,18 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -873,13 +872,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 index ec6293c5a7..db01fb4b00 100644 --- a/src/physics/carma/models/sea_salt/carma_model_mod.F90 +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -678,7 +678,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none diff --git a/src/physics/carma/models/sulfate/carma_model_mod.F90 b/src/physics/carma/models/sulfate/carma_model_mod.F90 index fb410e83c9..abf98d1820 100644 --- a/src/physics/carma/models/sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/sulfate/carma_model_mod.F90 @@ -11,7 +11,7 @@ !! - CARMA_EmitParticle() !! !! @version Dec-2010 -!! @author Tianyi Fan, Chuck Bardeen +!! @author Tianyi Fan, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -46,7 +46,7 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -68,7 +68,7 @@ module carma_model_mod ! should have a unique number. integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition integer, public, parameter :: I_WATER = 2 !! water - + ! Define group, element, solute and gas indexes. integer, public, parameter :: I_GRP_SULFATE = 1 !! sulfate aerosol @@ -88,17 +88,17 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) use physics_buffer, only: pbuf_add_field, dtype_r8 type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_SULFATE = 1.923_f ! dry density of sulfate particles (g/cm3) -! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: +! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: real(kind=f), parameter :: rmin = 3.43230298e-8_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.4_f ! volume ratio integer :: LUNOPRT @@ -109,7 +109,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -131,7 +131,7 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, is_sulfate=.true., shortname="PURSUL") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -139,19 +139,19 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "Sulfate", RHO_SULFATE, & I_VOLATILE, I_H2SO4, rc, shortname="PURSUL") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - - + + ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, & rc, shortname = "Q", ds_threshold=-0.2_f) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & I_GCOMP_H2SO4, rc, shortname = "H2SO4", ds_threshold=-0.2_f) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - + ! Define the Processes ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium @@ -166,7 +166,7 @@ subroutine CARMA_DefineModel(carma, rc) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') call pbuf_add_field('SADSULF', 'global', dtype_r8, (/pcols, pver/), ipbuf4sad) - + if (carma_rad_feedback) then call pbuf_add_field('VOLC_RAD_GEOM', 'global', dtype_r8, (/pcols, pver/), ipbuf4reff) call pbuf_add_field('VOLC_MMR', 'global', dtype_r8, (/pcols, pver/), ipbuf4so4mmr) @@ -178,8 +178,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -198,22 +198,22 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step @@ -227,33 +227,33 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t use physics_buffer, only: pbuf_get_field implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -264,7 +264,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) @@ -308,11 +308,11 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, md(:) = md(:) + mmr(:) ! bin integrated stratospheric mass mixing ratio (kg/kg) end if end do - + reff(:) = reff(:) / ad(:) ! wet effective radius in cm reff(:) = reff(:) / 100.0_r8 ! cm -> m ad(:) = ad(:) * 4.0_r8 * PI ! surface area density in cm2/cm3 - + call pbuf_get_field(pbuf, ipbuf4sad, sadsulf_ptr) sadsulf_ptr(icol, :cstate%f_NZ) = ad(:cstate%f_NZ) ! stratospheric aerosol wet surface area density (cm2/cm3) @@ -341,9 +341,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual use camsrfexch, only: cam_in_t - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -354,13 +354,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) integer, intent(out) :: rc !! return code, negative indicates failure - + ! Default return code. - rc = RC_OK - + rc = RC_OK + ! Add any surface flux here. surfaceFlux = 0._r8 - + ! For emissions into the atmosphere, put the emission here. tendency = 0._r8 @@ -381,7 +381,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency integer, intent(out) :: rc !! return code, negative indicates failure - + ! Default return code. rc = RC_OK @@ -400,7 +400,6 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none @@ -422,18 +421,18 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -441,13 +440,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/test_growth/carma_model_mod.F90 b/src/physics/carma/models/test_growth/carma_model_mod.F90 index 527d917b70..ad57aed469 100644 --- a/src/physics/carma/models/test_growth/carma_model_mod.F90 +++ b/src/physics/carma/models/test_growth/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -51,18 +51,18 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups integer, public, parameter :: NELEM = 3 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 1 !! Number of particle solutes integer, public, parameter :: NGAS = 1 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -91,12 +91,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_CN = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin_ice = 5.e-5_f ! min radius for ice bins (cm) @@ -104,7 +104,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -112,7 +112,7 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. - + ! Since these sulfates are prescribed, don't sediment them. This will save some ! processing time. call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, 4.0_f, I_SPHERE, 1._f, .false., & @@ -124,8 +124,8 @@ subroutine CARMA_DefineModel(carma, rc) rc, shortname="CRICE", ifallrtn=I_FALLRTN_STD_SHAPE) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -137,22 +137,22 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "Ice", RHO_I, & I_VOLATILE, I_ICE, rc, shortname="CRICE") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "Core Mass", RHO_CN, & I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=1) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + ! Define the Solutes call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, 98._f, 1.38_f, rc, shortname="CRH2SO4") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') - + ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - + ! Define the Processes call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') @@ -174,8 +174,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -184,7 +184,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -194,27 +194,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -223,18 +223,18 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + integer :: igroup ! group index integer :: ielem ! element index integer :: ibin ! bin index - + ! Sulfate size distribution parameters - real(r8), parameter :: n = 100._r8 ! concentration (cm-3) + real(r8), parameter :: n = 100._r8 ! concentration (cm-3) real(r8), parameter :: r0 = 2.5e-6_r8 ! mean radius (cm) real(r8), parameter :: rsig = 1.5_r8 ! distribution width - + real(r8) :: arg1(NBIN) real(r8) :: arg2(NBIN) real(r8) :: rhop(NBIN) ! particle mass density (kg/m3) @@ -246,7 +246,7 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! Default return code. rc = RC_OK - + ! Get the air density. call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') @@ -256,35 +256,35 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! improves the speed of the model. igroup = 1 ielem = 1 - + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') - + arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) rhop(:) = arg1(:) * exp(arg2(:)) * rmass(:) * 1e6_f / 1e3_f - + do ibin = 1, NBIN mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') end do - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -295,24 +295,24 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk - - + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no !! emission, but this routine can be overridden for models that wish to have !! an aerosol emission. @@ -328,7 +328,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -362,13 +362,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return end subroutine CARMA_EmitParticle @@ -384,7 +384,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -410,10 +410,10 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -431,12 +431,12 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! Put a horizontally uniform layer of the smallest bin size ! in the model. if (ibin == 1) then - if (ielem == I_ELEM_CRICE) then + if (ielem == I_ELEM_CRICE) then where(mask) q(:, plev/4) = 100e-7_r8 ! 1/4 end where end if - if (ielem == I_ELEM_CRCORE) then + if (ielem == I_ELEM_CRCORE) then where(mask) q(:, plev/4) = 100e-9_r8 ! 1/4 end where @@ -444,22 +444,22 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, plev/2) = 100e-9_r8 ! middle ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom - end if - + end if + return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -467,13 +467,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/test_passive/carma_model_mod.F90 b/src/physics/carma/models/test_passive/carma_model_mod.F90 index d616a2066a..12f4a6168e 100644 --- a/src/physics/carma/models/test_passive/carma_model_mod.F90 +++ b/src/physics/carma/models/test_passive/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -50,18 +50,18 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups integer, public, parameter :: NELEM = 1 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -70,19 +70,19 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_DUST = 1 !! dust composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) @@ -90,7 +90,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -102,8 +102,8 @@ subroutine CARMA_DefineModel(carma, rc) rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & scavcoef=0.1_f, shortname="DUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -111,13 +111,13 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') @@ -129,8 +129,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -139,7 +139,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -149,27 +149,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -178,32 +178,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -214,24 +214,24 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk - - + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no !! emission, but this routine can be overridden for models that wish to have !! an aerosol emission. @@ -247,7 +247,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -281,13 +281,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return end subroutine CARMA_EmitParticle @@ -303,7 +303,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -329,10 +329,10 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -357,22 +357,22 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - end if - + end if + return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -380,13 +380,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/test_radiative/carma_model_mod.F90 b/src/physics/carma/models/test_radiative/carma_model_mod.F90 index c394c8e220..8acff28edb 100644 --- a/src/physics/carma/models/test_radiative/carma_model_mod.F90 +++ b/src/physics/carma/models/test_radiative/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -50,7 +50,7 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups integer, public, parameter :: NELEM = 1 !! Number of particle elements @@ -64,7 +64,7 @@ module carma_model_mod !! humidities. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -73,19 +73,19 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_DUST = 1 !! dust composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) @@ -94,11 +94,11 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Use the same refractive index at all wavelengths. This value is typical of dust in ! the visible. refidx(:) = (1.55_f, 4e-3_f) - + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -110,8 +110,8 @@ subroutine CARMA_DefineModel(carma, rc) rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & scavcoef=0.1_f, shortname="DUST", refidx=refidx, do_mie=.true.) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -119,13 +119,13 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') @@ -137,8 +137,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -147,7 +147,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -157,27 +157,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -186,32 +186,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -222,20 +222,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -255,7 +255,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -289,13 +289,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return end subroutine CARMA_EmitParticle @@ -311,7 +311,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -337,10 +337,10 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -365,22 +365,22 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - end if - + end if + return end subroutine CARMA_InitializeParticle - + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -388,13 +388,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition - + end subroutine CARMA_WetDeposition + end module diff --git a/src/physics/carma/models/test_swelling/carma_model_mod.F90 b/src/physics/carma/models/test_swelling/carma_model_mod.F90 index 901f601c8a..ce55401475 100644 --- a/src/physics/carma/models/test_swelling/carma_model_mod.F90 +++ b/src/physics/carma/models/test_swelling/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -51,39 +51,39 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 3 !! Number of particle groups integer, public, parameter :: NELEM = 3 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? - + ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_SEA_SALT = 1 !! sea salt composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) @@ -91,7 +91,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -113,8 +113,8 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, shortname="SALTGB", irhswell=I_GERBER, & irhswcomp=I_SWG_SEA_SALT) if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -124,17 +124,17 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, 2, 2, "Fitz", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTFZ") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + call CARMAELEMENT_Create(carma, 3, 3, "Gerb", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTGB") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes return @@ -144,8 +144,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -154,7 +154,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -164,27 +164,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -193,32 +193,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -229,20 +229,20 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return end subroutine CARMA_DiagnoseBulk @@ -262,7 +262,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -296,13 +296,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return end subroutine CARMA_EmitParticle @@ -315,7 +315,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -341,10 +341,10 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -367,21 +367,21 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - + return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -389,13 +389,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/test_tracers/carma_model_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_mod.F90 index f357a6defd..9ed84a9471 100644 --- a/src/physics/carma/models/test_tracers/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -11,7 +11,7 @@ !! microphysics has its own version of this file. !! !! This file is a test case that uses CARMA groups and bins to implement a -!! tracer trajectory test for the Asian Monsoon region. This is the reverse of +!! tracer trajectory test for the Asian Monsoon region. This is the reverse of !! back trajectory calculations being done by John Bergman. In this model each !! group is a region of the model and each bin represents a day. Emissions !! start on the carma_launch_doy and then continue for NBINS days. @@ -20,8 +20,8 @@ !! the number of regions or days tracked, you also need to reduce the number of !! advected constituents added in configure. !! -!! @version April-2011 -!! @author Chuck Bardeen +!! @version April-2011 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -36,7 +36,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -57,18 +57,18 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 6 !! Number of particle groups integer, public, parameter :: NELEM = 6 !! Number of particle elements integer, public, parameter :: NBIN = 62 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -77,10 +77,10 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_INERT = 1 !! tracer composition - + real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, 0._f, 0._f, 0._f, 0._f /) real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 40._f, 40._f, 40._f, 40._f, 40._f /) - + real(kind=f), public :: rgn_minlon(NELEM-1) = (/ 60._f, 60._f, 105._f, 60._f, 105._f /) real(kind=f), public :: rgn_maxlon(NELEM-1) = (/ 105._f, 105._f, 140._f, 105._f, 140._f /) @@ -96,24 +96,24 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -133,10 +133,10 @@ subroutine CARMA_DefineModel(carma, rc) ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') @@ -148,18 +148,18 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 6, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - - + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') @@ -172,13 +172,13 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, 6, 6, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes @@ -189,8 +189,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -200,7 +200,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -210,27 +210,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -239,29 +239,29 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! When the tracer hits at the surface at a time other than on its launch day, !! it will be removed from the model. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 @@ -272,7 +272,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -283,14 +283,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + real(r8) :: calday ! current calendar day integer :: yr ! year integer :: mon ! month @@ -298,16 +298,16 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, integer :: ncsec ! time of day (seconds) integer :: doy ! day of year integer :: elapsed ! days since launch - - + + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + if (present(re_ice)) re_ice(:,:) = 0.0_f - + ! Determine the day of year. calday = get_curr_calday() if ( is_perpetual() ) then @@ -316,18 +316,18 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, call get_curr_date(yr, mon, day, ncsec) end if doy = floor(calday) - + ! Any material that has made it to the surface from a previous day should be removed. elapsed = doy - carma_launch_doy - + if (elapsed > 1) then cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f end if - + return end subroutine CARMA_DiagnoseBulk - - + + !! Calculates the emissions for CARMA aerosol particles. !! !! Emit particles after the specified launch day, with each bin being used @@ -362,7 +362,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physconst, only: gravit implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -421,10 +421,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Determine the region based upon latitude and longitude. The last region is ! defined to be rest of the world (i.e. all regions not in another region). doRegion = .False. - + if (ielem == NELEM) then doRegion = .True. - + do i = 1, NELEM-1 if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then @@ -442,7 +442,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doPS = .False. if (rgn_ps(ielem) == 0._f) then doPS = .True. - else + else if (rgn_ps(ielem) > 0._f) then if (state%ps(icol) > rgn_ps(ielem)) then doPS = .True. @@ -450,10 +450,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else if (state%ps(icol) <= abs(rgn_ps(ielem))) then doPS = .True. - end if + end if end if end if - + ! Calculate the emission rate as a constant mass. if (doRegion .and. doPS) then @@ -464,14 +464,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else ! For mmr, calculate a tendecy to keep the surface at that emitted value, ! rather than having a constant emission rate. -! tendency(icol, pver) = -carma_emission_rate - tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt end if end if ! Scale with the land/ocean fraction. frac = 0._f - + if (rgn_doLand(ielem)) then frac = frac + cam_in%landfrac(icol) end if @@ -487,7 +487,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(icol, pver) = tendency(icol, pver) * frac end do end if - + return end subroutine CARMA_EmitParticle @@ -503,7 +503,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -511,7 +511,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Default return code. rc = RC_OK - + return end subroutine CARMA_InitializeModel @@ -527,10 +527,9 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -551,21 +550,21 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q(:,i) = 0._r8 end where end do - + return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -573,13 +572,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module diff --git a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 index e5595a367e..ecb3324ed8 100644 --- a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -11,7 +11,7 @@ !! microphysics has its own version of this file. !! !! This file is a test case that uses CARMA groups and bins to implement a -!! tracer trajectory test for the Guam region. This is the reverse of +!! tracer trajectory test for the Guam region. This is the reverse of !! back trajectory calculations being done by John Bergman. In this model each !! group is a region of the model and each bin represents a day. Emissions !! start on the carma_launch_doy and then continue for NBINS days. @@ -20,8 +20,8 @@ !! the number of regions or days tracked, you also need to reduce the number of !! advected constituents added in configure. !! -!! @version April-2011 -!! @author Chuck Bardeen +!! @version April-2011 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -36,7 +36,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -57,18 +57,18 @@ module carma_model_mod public CARMA_InitializeModel public CARMA_InitializeParticle public CARMA_WetDeposition - + ! Declare public constants integer, public, parameter :: NGROUP = 7 !! Number of particle groups integer, public, parameter :: NELEM = 7 !! Number of particle elements integer, public, parameter :: NBIN = 62 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -78,7 +78,7 @@ module carma_model_mod ! should have a unique number. integer, public, parameter :: I_INERT = 1 !! tracer composition - ! Regions for ATTREX + ! Regions for ATTREX real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, -20._f, -30._f, -20._f, -10._f, -30._f /) real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 20._f, 0._f, 20._f, 20._f, 20._f, -10._f /) @@ -97,24 +97,24 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen subroutine CARMA_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -134,10 +134,10 @@ subroutine CARMA_DefineModel(carma, rc) ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') @@ -153,17 +153,17 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 7, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG7") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') @@ -179,13 +179,13 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, 7, 7, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG7") if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + ! Define the Solutes - + ! Define the Gases - + ! Define the Processes @@ -196,8 +196,8 @@ end subroutine CARMA_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & @@ -207,7 +207,7 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -217,27 +217,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return end subroutine CARMA_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -246,29 +246,29 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return end subroutine CARMA_DiagnoseBins - - + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! When the tracer hits at the surface at a time other than on its launch day, !! it will be removed from the model. !! - !! @version July-2009 - !! @author Chuck Bardeen + !! @version July-2009 + !! @author Chuck Bardeen subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 @@ -279,7 +279,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -290,14 +290,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + real(r8) :: calday ! current calendar day integer :: yr ! year integer :: mon ! month @@ -305,16 +305,16 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, integer :: ncsec ! time of day (seconds) integer :: doy ! day of year integer :: elapsed ! days since launch - - + + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + if (present(re_ice)) re_ice(:,:) = 0.0_f - + ! Determine the day of year. calday = get_curr_calday() if ( is_perpetual() ) then @@ -323,18 +323,18 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, call get_curr_date(yr, mon, day, ncsec) end if doy = floor(calday) - + ! Any material that has made it to the surface from a previous day should be removed. elapsed = doy - carma_launch_doy - + if (elapsed > 1) then cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f end if - + return end subroutine CARMA_DiagnoseBulk - - + + !! Calculates the emissions for CARMA aerosol particles. !! !! Emit particles after the specified launch day, with each bin being used @@ -369,7 +369,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physconst, only: gravit implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -420,19 +420,19 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if ((elapsed + 1) == ibin) then ! Determine the latitude and longitude of each column. - + lat = state%lat(:ncol) / DEG2RAD lon = state%lon(:ncol) / DEG2RAD - + do icol = 1, ncol ! Determine the region based upon latitude and longitude. The last region is ! defined to be rest of the world (i.e. all regions not in another region). doRegion = .False. - + if (ielem == NELEM) then doRegion = .True. - + do i = 1, NELEM-1 if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then @@ -450,7 +450,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doPS = .False. if (rgn_ps(ielem) == 0._f) then doPS = .True. - else + else if (rgn_ps(ielem) > 0._f) then if (state%ps(icol) > rgn_ps(ielem)) then doPS = .True. @@ -458,10 +458,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else if (state%ps(icol) <= abs(rgn_ps(ielem))) then doPS = .True. - end if + end if end if end if - + ! Calculate the emission rate as a constant mass. if (doRegion .and. doPS) then @@ -472,14 +472,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else ! For mmr, calculate a tendecy to keep the surface at that emitted value, ! rather than having a constant emission rate. -! tendency(icol, pver) = -carma_emission_rate - tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt end if end if ! Scale with the land/ocean fraction. frac = 0._f - + if (rgn_doLand(ielem)) then frac = frac + cam_in%landfrac(icol) end if @@ -495,7 +495,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(icol, pver) = tendency(icol, pver) * frac end do end if - + return end subroutine CARMA_EmitParticle @@ -511,7 +511,7 @@ end subroutine CARMA_EmitParticle subroutine CARMA_InitializeModel(carma, lq_carma, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency @@ -519,7 +519,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Default return code. rc = RC_OK - + return end subroutine CARMA_InitializeModel @@ -535,10 +535,9 @@ end subroutine CARMA_InitializeModel !! @version May-2009 subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -559,21 +558,21 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q(:,i) = 0._r8 end where end do - + return end subroutine CARMA_InitializeParticle - - + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen + !! @version July-2011 + !! @author Chuck Bardeen subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -581,13 +580,13 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMA_WetDeposition end module From 950110feba43a5fe4a0f5a28b63e297c9e1a6ffa Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 13 Oct 2022 11:34:14 -0600 Subject: [PATCH 07/14] correct dry dep history field description; misc cleanup modified: src/physics/carma/cam/carma_constants_mod.F90 modified: src/physics/carma/cam/carma_intr.F90 --- src/physics/carma/cam/carma_constants_mod.F90 | 4 +--- src/physics/carma/cam/carma_intr.F90 | 3 +-- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/physics/carma/cam/carma_constants_mod.F90 b/src/physics/carma/cam/carma_constants_mod.F90 index 10715cd1e6..e7392cc6a5 100644 --- a/src/physics/carma/cam/carma_constants_mod.F90 +++ b/src/physics/carma/cam/carma_constants_mod.F90 @@ -104,9 +104,7 @@ module carma_constants_mod !! !! For degree/degree/hybrid coordinates, the metric is on the !! order of 1e20. -! real(kind=f), parameter :: SMALL_PC = 1e-50_f -! real(kind=f), parameter :: SMALL_PC = FEW_PC * 1e20 * 1e-30 ! with xmet,ymet=1 this needs to change - real(kind=f), parameter :: SMALL_PC = FEW_PC * 1.e-30_f ! ?? + real(kind=f), parameter :: SMALL_PC = FEW_PC * 1.e-30_f !! Define core fraction (for core mass and second moment) used !! when particle number concentrations are limited to SMALL_PC diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 20c139e646..ec935e29b4 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -645,9 +645,8 @@ subroutine carma_init ! Per bin stats .. if (do_drydep) then do ibin = 1, NBIN - !!! WHAT is icnst here ?????? call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & - trim(cnst_name(icnst)) // ' dry deposition velocity') + trim(btndname(igroup, ibin))//' dry deposition velocity') end do end if From bf90a279b74c36913914546302ad4a67b3d8cea7 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 13 Oct 2022 14:22:02 -0600 Subject: [PATCH 08/14] set ubc_specifier for waccm_ma_sulfur chemistry modified: cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam modified: cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam --- .../testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam | 5 +++-- .../testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam | 6 +++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam index 5b78ea3798..52b192f861 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam @@ -6,8 +6,9 @@ pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" -flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', - 'HCFC22', 'N2O', 'OCS' +flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'OCS' solar_data_type='FIXED' solar_data_ymd=20000101 carma_maxretries = 40 +ubc_specifier = 'T->MSIS', 'Q->2.d-8vmr', 'CH4->2.d-10vmr', 'H->MSIS', 'N->MSIS', 'O->MSIS', 'O2->MSIS', 'H2->TGCM', 'NO->SNOE' diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam index c080a8a8aa..cfc4580f54 100644 --- a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam @@ -6,8 +6,8 @@ pbuf_global_allocate=.false. history_carma=.true. carma_do_fixedinit=.false. carma_reftfile="camrun.cam.r.carma_reft.nc" -flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', - 'HCFC22', 'N2O', 'OCS' +flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'OCS' solar_data_type='FIXED' solar_data_ymd=20000101 - +ubc_specifier = 'T->MSIS', 'Q->2.d-8vmr', 'CH4->2.d-10vmr', 'H->MSIS', 'N->MSIS', 'O->MSIS', 'O2->MSIS', 'H2->TGCM', 'NO->SNOE' From 26ca7f4a3d4ad730c83d75c84e52c1f0649db95f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 11 Sep 2023 07:13:00 -0600 Subject: [PATCH 09/14] Add comment and wallclock time to new CARMA tests modified: cime_config/testdefs/testlist_cam.xml --- cime_config/testdefs/testlist_cam.xml | 54 ++++++++++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 9471b2edc6..fc511a78b4 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -780,82 +780,134 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 544fdad534f68cca65178bbaf914e01012956929 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 12 Sep 2023 17:29:09 -0600 Subject: [PATCH 10/14] fix r8 issue in refractive_aerosol_optics_mod --- src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 index a789db0383..e1289a8790 100644 --- a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -285,7 +285,7 @@ subroutine lw_props(self, ncol, ilev, iwav, pabs) do icol = 1, ncol crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) - crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40_r8) refr(icol) = real(crefin(icol)) refi(icol) = aimag(crefin(icol)) From b06cf016b098c5f06bf15d17126082e67e7f4dd0 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Sep 2023 07:33:37 -0600 Subject: [PATCH 11/14] Correct default IC file for QPWmaC6 on ne5np4 grid modified: bld/namelist_files/namelist_defaults_cam.xml --- bld/namelist_files/namelist_defaults_cam.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index cff1f96b71..fc74b3e978 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -141,6 +141,7 @@ atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc atm/waccm/ic/aqua_waccm_ma_ne5np4_70L_c220729.nc +atm/waccm/ic/aqua_waccm_ma_ne5np4_70L_c220729.nc atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc atm/waccm/ic/f2000.waccm-mam3_10x15_L70.cam2.i.0017-01-01.c141016.nc atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc From 7e9b1c68cce48ba6bec49e4aa0e4764ba722b6db Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Sep 2023 09:00:27 -0600 Subject: [PATCH 12/14] ChangeLog draft --- doc/ChangeLog | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index af188b509a..575cd84060 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,117 @@ =============================================================== +Tag name: cam6_3_128 +Originator(s): fvitt +Date: 13 Sep 2023 +One-line Summary: Enable CARMA models to run on unsctructured grids +Github PR URL: https://github.com/ESCOMP/CAM/pull/650 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Address issues: + Need capability to run existing CARMA models on unstructured grids #649 + refractive_aerosol_optics_mod.F90 is missing an r8 qualifier #882 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - update CARMA base tag carma4_01 + +M bld/namelist_files/namelist_defaults_cam.xml + - default IC file for QPWmaC6 on ne5 grid + +M cime_config/testdefs/testlist_cam.xml + - new tests carma models, mostly for coarse SE grids + +M cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam + - include CRSLERFC in h1 output + +M cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam + - set wide impact zone for coarse grid testing + +M cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam + - increase carma_maxretries + - specified UBCs + +M src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 + - include "_r8" kind in limit constant + +M src/physics/carma/cam/carma_constants_mod.F90 + - remove commented out line + +M src/physics/carma/cam/carma_intr.F90 + - remove Cartesian coordinate and spacing stuff + - misc clean up and corrections + +M src/physics/carma/models/dust/carma_model_mod.F90 +M src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M src/physics/carma/models/sea_salt/carma_model_mod.F90 + - changes for generalized grid columns + +M src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M src/physics/carma/models/pmc/carma_model_mod.F90 +M src/physics/carma/models/sulfate/carma_model_mod.F90 +M src/physics/carma/models/test_growth/carma_model_mod.F90 +M src/physics/carma/models/test_passive/carma_model_mod.F90 +M src/physics/carma/models/test_radiative/carma_model_mod.F90 +M src/physics/carma/models/test_swelling/carma_model_mod.F90 +M src/physics/carma/models/test_tracers/carma_model_mod.F90 +M src/physics/carma/models/test_tracers2/carma_model_mod.F90 + - minor clean up + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + Tag name: cam6_3_127 Originator(s): pel, jet Date: Sept 12, 2023 From e85b90641c7951fc0cc0b74d630df90dfc889d2a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Sep 2023 13:20:12 -0600 Subject: [PATCH 13/14] ChangeLog update --- doc/ChangeLog | 39 ++++++++++++++------------------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 575cd84060..cd4f67e4be 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -59,9 +59,11 @@ M src/physics/carma/cam/carma_intr.F90 M src/physics/carma/models/dust/carma_model_mod.F90 M src/physics/carma/models/meteor_impact/carma_model_mod.F90 -M src/physics/carma/models/sea_salt/carma_model_mod.F90 - changes for generalized grid columns +M src/physics/carma/models/sea_salt/carma_model_mod.F90 + - removed ununsed lat/lon indices + M src/physics/carma/models/meteor_smoke/carma_model_mod.F90 M src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 M src/physics/carma/models/pmc/carma_model_mod.F90 @@ -72,7 +74,7 @@ M src/physics/carma/models/test_radiative/carma_model_mod.F90 M src/physics/carma/models/test_swelling/carma_model_mod.F90 M src/physics/carma/models/test_tracers/carma_model_mod.F90 M src/physics/carma/models/test_tracers2/carma_model_mod.F90 - - minor clean up + - minor clean up -- remove unused "module uses" If there were any failures reported from running test_driver.sh on any test platform, and checkin with these failures has been OK'd by the gatekeeper, @@ -80,34 +82,21 @@ then copy the lines from the td.*.status files for the failed tests to the appropriate machine below. All failed tests must be justified. cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure -izumi/gnu/aux_cam: - -CAM tag used for the baseline comparison tests if different than previous -tag: - -Summarize any changes to answers, i.e., -- what code configurations: -- what platforms/compilers: -- nature of change (roundoff; larger than roundoff but same climate; new - climate): - -If bitwise differences were observed, how did you show they were no worse -than roundoff? - -If this tag changes climate describe the run(s) done to evaluate the new -climate in enough detail that it(they) could be reproduced, i.e., -- source tag (all code used must be in the repository): -- platform/compilers: -- configure commandline: -- build-namelist command (or complete namelist): -- MSS location of output: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_127_nag: DIFF + - round-off level changes in carma base code -MSS location of control simulations used to validate new climate: +izumi/gnu/aux_cam: All PASS -URL for AMWG diagnostics output used to validate new climate: +Summarize any changes to answers: CARMA round-off level changes, otherwise bit-for-bit unchanged =============================================================== =============================================================== From e91b687a2b514d2461d016702314f572a6da2a67 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Sep 2023 13:36:46 -0600 Subject: [PATCH 14/14] ChangeLog update --- doc/ChangeLog | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index cd4f67e4be..2397b96619 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -3,7 +3,7 @@ Tag name: cam6_3_128 Originator(s): fvitt Date: 13 Sep 2023 -One-line Summary: Enable CARMA models to run on unsctructured grids +One-line Summary: Enable use of CARMA aerosol packages with unstructured grids Github PR URL: https://github.com/ESCOMP/CAM/pull/650 Purpose of changes (include the issue number and title text for each relevant GitHub issue): @@ -12,19 +12,19 @@ Address issues: Need capability to run existing CARMA models on unstructured grids #649 refractive_aerosol_optics_mod.F90 is missing an r8 qualifier #882 -Describe any changes made to build system: +Describe any changes made to build system: n/a -Describe any changes made to the namelist: +Describe any changes made to the namelist: n/a -List any changes to the defaults for the boundary datasets: +List any changes to the defaults for the boundary datasets: n/a -Describe any substantial timing or memory changes: +Describe any substantial timing or memory changes: n/a -Code reviewed by: +Code reviewed by: cacraigucar nusbaume -List all files eliminated: +List all files eliminated: n/a -List all files added and what they do: +List all files added and what they do: n/a List all existing files that have been modified, and describe the changes: M Externals_CAM.cfg