#include MODULE UW_CONV_MOD use mpp_mod, only : mpp_pe, mpp_root_pe, stdlog use Constants_Mod, ONLY: tfreeze,HLv,HLf,HLs,CP_AIR,GRAV,Kappa,rdgas,rvgas use Diag_Manager_Mod, ONLY: register_diag_field, send_data use Time_Manager_Mod, ONLY: time_type, get_time use mpp_mod, only : input_nml_file use fms_mod, only : write_version_number, open_namelist_file, check_nml_error,& FILE_EXIST, ERROR_MESG, & lowercase, & CLOSE_FILE, FATAL use field_manager_mod, only: MODEL_ATMOS use tracer_manager_mod, only: get_tracer_names, query_method, & get_tracer_index, NO_TRACER use sat_vapor_pres_mod,only : sat_vapor_pres_init use atmos_tracer_utilities_mod, only : get_wetdep_param use rad_utilities_mod, only : aerosol_type use aer_ccn_act_mod, only : aer_ccn_act_init use conv_utilities_mod,only : uw_params_init use conv_utilities_k_mod,only : sd_init_k, sd_copy_k, sd_end_k, & ac_init_k, ac_clear_k, ac_end_k, & pack_sd_k, adi_cloud_k, extend_sd_k,& exn_init_k, exn_end_k, findt_init_k,& findt_end_k, & check_tracer_realizability, & qt_parcel_k, & adicloud, sounding, uw_params use conv_plumes_k_mod,only : cp_init_k, cp_end_k, cp_clear_k, & ct_init_k, ct_end_k, ct_clear_k, & cumulus_tend_k, cumulus_plume_k, & cplume, ctend, cpnlist, cwetdep_type use conv_closures_mod,only : cclosure_bretherton, & cclosure_relaxcbmf, & cclosure_relaxwfn, & cclosure_implicit, cclosure use deep_conv_mod,only : deepc, cpn_copy, dpconv0, dpconv1, dpconv2 !--------------------------------------------------------------------- implicit none private !--------------------------------------------------------------------- !----------- ****** VERSION NUMBER ******* --------------------------- character(len=128) :: version = '$Id: uw_conv.F90,v 20.0 2013/12/13 23:21:41 fms Exp $' character(len=128) :: tagname = '$Name: tikal $' !--------------------------------------------------------------------- !------- interfaces -------- public :: uw_conv, uw_conv_init, uw_conv_end real, parameter :: aday = 1. real, parameter :: mv = -999. logical :: module_is_initialized = .false. character(len=7) :: mod_name = 'uw_conv' !namelist parameters for UW convection scheme integer :: iclosure = 0 ! 0: Bretherton UWShCu orginal / -CIN/TKE based ! 1: Emanuel-Rayment: quasiequilibrium PBL real :: rkm_sh = 16.0 ! fractional lateral mixing rate for shallow real :: cldhgt_max = 4.e3 real :: landfact_m = 0.0 integer :: idpchoice = 0 logical :: do_deep = .false. logical :: do_relaxcape = .false. logical :: do_relaxwfn = .false. logical :: do_coldT = .true. logical :: do_lands = .false. logical :: do_uwcmt = .false. logical :: do_fast = .false. logical :: do_ice = .true. logical :: do_ppen = .true. logical :: do_forcedlifting = .false. real :: atopevap = 0. logical :: apply_tendency = .true. logical :: prevent_unreasonable = .true. real :: aerol = 1.e-12 real :: gama = 1.0 ! real :: tkemin = 1.e-6 real :: wmin_ratio = 0. logical :: use_online_aerosol = .false. logical :: use_sub_seasalt = .true. logical :: do_auto_aero = .false. logical :: do_rescale = .false. logical :: do_debug = .false. !miz logical :: do_imposing_cooling_drying = .false. real :: tdt_rate = 0.0 real :: qvdt_rate = 0.0 real :: pres_min = 0.0 real :: pres_max = 0.0 logical :: do_imposing_rad_cooling = .false. logical :: do_no_uw_conv = .false. real :: cooling_rate = -1.5 !K/day real :: t_thresh = 207.5 !K real :: t_strato = 200.0 !K real :: tau_rad = 5.0 !day !miz integer :: cush_choice = 0 real :: pcp_min = 3e-5 real :: pcp_max = 1.5e-3 real :: rh0 = 0.8 real :: cush_ref = 0. real :: pblht0 = 500. real :: tke0 = 1. real :: lofactor0 = 1. integer :: lochoice = 0 real :: wrel_min = 1. real :: om_to_oc = 1.67 real :: sea_salt_scale = 0.1 logical :: do_qctflx_zero = .false. logical :: do_detran_zero = .false. logical :: do_gust_cv = .false. real :: gustmax = 3.! maximum gustiness wind (m/s) real :: gustconst = 10./86400. ! constant in kg/m2/sec, default = ! 1 cm/day = 10 mm/day NAMELIST / uw_conv_nml / iclosure, rkm_sh, cldhgt_max, & do_deep, idpchoice, do_relaxcape, do_relaxwfn, do_coldT, do_lands, do_uwcmt, & do_fast, do_ice, do_ppen, do_forcedlifting, & atopevap, apply_tendency, prevent_unreasonable, aerol, gama, tkemin, & wmin_ratio, use_online_aerosol, use_sub_seasalt, landfact_m, pblht0, tke0, lofactor0, lochoice, & do_auto_aero, do_rescale, wrel_min, om_to_oc, sea_salt_scale, & do_debug, cush_choice, pcp_min, pcp_max, cush_ref, & rh0, do_qctflx_zero, do_detran_zero, do_gust_cv, gustmax, gustconst, & do_imposing_cooling_drying, tdt_rate, qvdt_rate, pres_min, pres_max, & do_imposing_rad_cooling, do_no_uw_conv, cooling_rate, t_thresh, t_strato, tau_rad !namelist parameters for UW convective plume real :: rle = 0.10 ! for critical stopping distance for entrainment real :: rpen = 5.0 ! for entrainment efficiency real :: rmaxfrac = 0.05 ! maximum allowable updraft fraction real :: wmin = 0.0 ! maximum allowable updraft fraction real :: rbuoy = 1.0 ! for nonhydrostatic pressure effects on updraft real :: rdrag = 1.0 real :: frac_drs = 0.0 ! real :: bigc = 0.7 ! for momentum transfer real :: auto_th0 = 0.5e-3 ! threshold for precipitation real :: auto_rate= 1.e-3 real :: tcrit = -45.0 ! critical temperature real :: deltaqc0 = 0.5e-3 logical :: do_pdfpcp= .false. logical :: do_pmadjt= .false. logical :: do_emmax = .false. logical :: do_pnqv = .false. real :: rad_crit = 14.0 ! critical droplet radius real :: emfrac_max = 1.0 integer :: mixing_assumption = 0 integer :: mp_choice = 1 real :: Nl_land = 300.e6 real :: Nl_ocean = 100.e6 real :: qi_thresh = 1.e-4 real :: r_thresh = 12.e-6 logical :: do_pevap = .false. real :: cfrac = 0.05 real :: hcevap = 0.8 logical :: do_weffect = .false. real :: weffect = 0.5 real :: peff_l = 1.0 real :: peff_i = 1.0 real :: t00 = 295 NAMELIST / uw_plume_nml / rle, rpen, rmaxfrac, wmin, rbuoy, rdrag, frac_drs, bigc, & auto_th0, auto_rate, tcrit, deltaqc0, do_pdfpcp, do_pmadjt, do_emmax, do_pnqv, rad_crit, emfrac_max, & mixing_assumption, mp_choice, Nl_land, Nl_ocean, qi_thresh, r_thresh, do_pevap, cfrac, hcevap, & do_weffect, weffect, peff_l, peff_i, t00 !namelist parameters for UW convective closure integer :: igauss = 1 ! options for cloudbase massflux closure ! 1: cin/gaussian closure, using TKE to compute CIN. ! 2: cin/gaussian closure, using W* to compute CIN. ! 0: cin/tke mapse-style closure; real :: rkfre = 0.05 ! vertical velocity variance as fraction of tke real :: tau_sh = 7200. ! real :: wcrit_min= 0. NAMELIST / uw_closure_nml / igauss, rkfre, tau_sh, wcrit_min !========Option for deep convection======================================= real :: rkm_dp1 = 10. real :: rkm_dp2 = 1. real :: cbmf_dp_frac1 = 0. real :: cbmf_dp_frac2 = 1. real :: crh_th_ocean = 100. real :: crh_th_land = 100. real :: cape_th = 0. real :: tau_dp = 7200. real :: rpen_d = 5.0 integer :: mixing_assumption_d = 0 integer :: norder = 1 logical :: do_ppen_d = .true. logical :: do_pevap_d = .true. real :: cfrac_d = 0.05 real :: hcevap_d = 0.8 real :: dcapedm_th = 0 real :: frac_limit_d = 0.25 real :: lofactor_d = 1.0 real :: auto_th0_d = 1.0e-3 real :: tcrit_d = -120 logical :: do_forcedlifting_d = .false. logical :: do_lod_rkm = .false. logical :: do_lod_cfrac = .false. logical :: do_lod_tcrit = .false. NAMELIST / deep_conv_nml / rkm_dp1, rkm_dp2, cbmf_dp_frac1, cbmf_dp_frac2, & crh_th_ocean, crh_th_land, do_forcedlifting_d, frac_limit_d, & cape_th, tau_dp, rpen_d, mixing_assumption_d, norder, & do_ppen_d, do_pevap_d, cfrac_d, hcevap_d, lofactor_d, dcapedm_th, & auto_th0_d, tcrit_d, do_lod_rkm, do_lod_cfrac, do_lod_tcrit !========Option for deep convection======================================= !------------------------------------------------------------------------ integer :: nqv, nql, nqi, nqa ,nqn logical :: do_qn = .false. ! use droplet number tracer field ? integer :: id_tdt_uwc, id_qdt_uwc, id_prec_uwc, id_snow_uwc, & id_cin_uwc, id_cbmf_uwc, id_tke_uwc, id_plcl_uwc, id_zinv_uwc, & id_cush_uwc, id_pct_uwc, id_pcb_uwc, id_plfc_uwc, id_enth_uwc, & id_qldt_uwc, id_qidt_uwc, id_qadt_uwc, id_qndt_uwc, id_cmf_uwc, id_wu_uwc, & id_fer_uwc, id_fdr_uwc, id_fdrs_uwc, id_cqa_uwc, id_cql_uwc, & id_cqi_uwc, id_cqn_uwc, id_hlflx_uwc, id_qtflx_uwc, & id_cape_uwc, id_dcin_uwc, id_dcape_uwc, id_dwfn_uwc, id_crh_uwc,& id_ocode_uwc, id_plnb_uwc, id_wrel_uwc, id_ufrc_uwc, id_qtmp_uwc,& id_tdt_pevap_uwc, id_qdt_pevap_uwc, id_xhlsrc_uwc, id_xqtsrc_uwc,& id_qldet_uwc, id_qidet_uwc, id_qadet_uwc, id_qtdt_uwc, id_dting_uwc, & id_cfq_uwc, id_fdp_uwc, id_hmo_uwc, id_hms_uwc, id_abu_uwc, id_peo_uwc, & id_tdt_rad_uwc integer, allocatable :: id_tracerdt_uwc(:), id_tracerdt_uwc_col(:), & id_tracerdtwet_uwc(:), id_tracerdtwet_uwc_col(:) !========Option for deep convection======================================= integer :: id_tdt_uwd, id_qdt_uwd, id_qtdt_uwd, id_prec_uwd, id_snow_uwd, & id_cbmf_uwd, id_enth_uwd, id_qldt_uwd, id_qidt_uwd, & id_qndt_uwd, id_qadt_uwd, id_cmf_uwd, id_wu_uwd, id_fer_uwd, & id_fdr_uwd, id_fdrs_uwd, id_cqa_uwd, id_cql_uwd, id_cqi_uwd, & id_cqn_uwd, id_hlflx_uwd, id_qtflx_uwd, id_dcin_uwd, & id_dcapedm_uwd, id_dwfn_uwd, id_ocode_uwd, & id_tdt_pevap_uwd, id_qdt_pevap_uwd, id_rkm_uwd, id_cbu_uwd !========Option for deep convection======================================= type(cwetdep_type), dimension(:), allocatable :: wetdep type(uw_params), save :: Uw_p character(len=32), dimension(:), allocatable :: tracername character(len=32), dimension(:), allocatable :: tracer_units contains !##################################################################### !##################################################################### SUBROUTINE UW_CONV_INIT(do_strat, axes, Time, kd, tracers_in_uw) logical, intent(in) :: do_strat integer, intent(in) :: axes(4), kd type(time_type), intent(in) :: Time logical, intent(in) :: tracers_in_uw(:) !--------------------------------------------------------------------- ! intent(in) variables: ! ! tracers_in_uw ! logical array indicating which of the activated ! tracers are to be transported by UW convection ! !------------------------------------------------------------------- integer :: unit, io integer :: ntracers, n, nn, ierr, logunit logical :: flag character(len=200) :: text_in_scheme, control real :: frac_junk, frac_junk2 ntracers = count(tracers_in_uw) call uw_params_init (Uw_p) ! Initialize lookup tables needed for findt and exn ! sat_vapor_pres needs to be initialized if not already done call sat_vapor_pres_init call exn_init_k (Uw_p) call findt_init_k (Uw_p) #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=uw_closure_nml, iostat=io) ierr = check_nml_error(io,'uw_closure_nml') read (input_nml_file, nml=uw_conv_nml, iostat=io) ierr = check_nml_error(io,'uw_conv_nml') read (input_nml_file, nml=uw_plume_nml, iostat=io) ierr = check_nml_error(io,'uw_plume_nml') read (input_nml_file, nml=deep_conv_nml, iostat=io) ierr = check_nml_error(io,'deep_conv_nml') #else if( FILE_EXIST( 'input.nml' ) ) then unit = OPEN_NAMELIST_FILE () io = 1 do while ( io .ne. 0 ) READ( unit, nml = uw_closure_nml, iostat = io, end = 10 ) ierr = check_nml_error(io,'uw_closure_nml') end do 10 call close_file ( unit ) unit = OPEN_NAMELIST_FILE () io = 1 do while ( io .ne. 0 ) READ( unit, nml = uw_conv_nml, iostat = io, end = 20 ) ierr = check_nml_error(io,'uw_conv_nml') end do 20 call close_file ( unit ) unit = OPEN_NAMELIST_FILE () io = 1 do while ( io .ne. 0 ) READ( unit, nml = uw_plume_nml, iostat = io, end = 30 ) ierr = check_nml_error(io,'uw_plume_nml') end do 30 call close_file ( unit ) !========Option for deep convection======================================= unit = OPEN_NAMELIST_FILE () io = 1 do while ( io .ne. 0 ) READ( unit, nml = deep_conv_nml, iostat = io, end = 40 ) ierr = check_nml_error(io,'deep_conv_nml') end do 40 call close_file ( unit ) !========Option for deep convection======================================= end if #endif call write_version_number(version, tagname) logunit = stdlog() WRITE( logunit, nml = uw_closure_nml ) WRITE( logunit, nml = uw_conv_nml ) WRITE( logunit, nml = uw_plume_nml ) WRITE( logunit, nml = deep_conv_nml ) if ( use_online_aerosol ) call aer_ccn_act_init nqv = get_tracer_index ( MODEL_ATMOS, 'sphum' ) nql = get_tracer_index ( MODEL_ATMOS, 'liq_wat' ) nqi = get_tracer_index ( MODEL_ATMOS, 'ice_wat' ) nqa = get_tracer_index ( MODEL_ATMOS, 'cld_amt' ) nqn = get_tracer_index ( MODEL_ATMOS, 'liq_drp' ) if (nqn /= NO_TRACER) do_qn = .true. if (ntracers > 0) then allocate ( tracername (ntracers) ) allocate ( tracer_units (ntracers) ) allocate ( wetdep (ntracers) ) nn = 1 do n=1,size(tracers_in_uw(:)) if (tracers_in_uw(n)) then call get_tracer_names (MODEL_ATMOS, n, & name = tracername(nn), & units = tracer_units(nn)) flag = query_method( 'wet_deposition', MODEL_ATMOS, n, & text_in_scheme, control ) call get_wetdep_param( text_in_scheme, control, & wetdep(nn)%scheme, & wetdep(nn)%Henry_constant, & wetdep(nn)%Henry_variable, & frac_junk, frac_junk2, & wetdep(nn)%alpha_r, & wetdep(nn)%alpha_s, & wetdep(nn)%Lwetdep, & wetdep(nn)%Lgas, & wetdep(nn)%Laerosol, & wetdep(nn)%Lice, & frac_in_cloud_uw=wetdep(nn)%frac_in_cloud ) wetdep(nn)%scheme = lowercase( wetdep(nn)%scheme ) nn = nn + 1 endif end do endif id_xhlsrc_uwc = register_diag_field (mod_name,'xhlsrc_uwc', axes(1:2), Time, & 'xhlsrc', 'J/kg' ) id_xqtsrc_uwc = register_diag_field (mod_name,'xqtsrc_uwc', axes(1:2), Time, & 'xqtsrc', 'kg/kg' ) id_tdt_pevap_uwc = register_diag_field ( mod_name, 'tdt_pevap_uwc', axes(1:3), Time, & 'Temperature tendency due to pevap from uw_conv', 'K/s', missing_value=mv ) id_qdt_pevap_uwc = register_diag_field ( mod_name, 'qdt_pevap_uwc', axes(1:3), Time, & 'Spec. humidity tendency due to pevap from uw_conv', 'kg/kg/s', missing_value=mv) id_tdt_uwc = register_diag_field ( mod_name, 'tdt_uwc', axes(1:3), Time, & 'Temperature tendency from uw_conv', 'K/s', missing_value=mv ) id_qdt_uwc = register_diag_field ( mod_name, 'qdt_uwc', axes(1:3), Time, & 'Spec. humidity tendency from uw_conv', 'kg/kg/s', missing_value=mv) id_cmf_uwc = register_diag_field ( mod_name, 'cmf_uwc', axes(1:3), Time, & 'Cloud vert. mass flux from uw_conv', 'kg/m2/s', missing_value=mv) id_cfq_uwc = register_diag_field ( mod_name, 'cfq_uwc', axes(1:3), Time, & 'Convective frequency', 'none', missing_value=mv) id_peo_uwc = register_diag_field ( mod_name, 'peo_uwc', axes(1:3), Time, & 'Convective precipitation efficiency', 'none', missing_value=mv) id_hmo_uwc = register_diag_field ( mod_name, 'hmo_uwc', axes(1:3), Time, & 'moist static energy', 'J/kg', missing_value=mv) id_hms_uwc = register_diag_field ( mod_name, 'hms_uwc', axes(1:3), Time, & 'moist static energy', 'J/kg', missing_value=mv) id_abu_uwc = register_diag_field ( mod_name, 'abu_uwc', axes(1:3), Time, & 'adiabatic buoyancy', 'K', missing_value=mv) id_wu_uwc = register_diag_field ( mod_name, 'wu_uwc', axes(1:3), Time, & 'Updraft vert. velocity from uw_conv', 'm/s', missing_value=mv) id_fer_uwc = register_diag_field ( mod_name, 'fer_uwc', axes(1:3), Time, & 'Fractional entrainment rate from uw_conv', '1/Pa', missing_value=mv) id_fdr_uwc = register_diag_field ( mod_name, 'fdr_uwc', axes(1:3), Time, & 'Fractional detrainment rate from uw_conv', '1/Pa', missing_value=mv) id_fdrs_uwc = register_diag_field (mod_name,'fdrs_uwc', axes(1:3), Time, & 'Detrainment rate for sat. air from uw_conv', '1/Pa', missing_value=mv) id_cqa_uwc = register_diag_field ( mod_name, 'cqa_uwc', axes(1:3), Time, & 'Updraft fraction from uw_conv', 'none', missing_value=mv) id_cql_uwc = register_diag_field ( mod_name, 'cql_uwc', axes(1:3), Time, & 'Updraft liquid from uw_conv', 'kg/kg', missing_value=mv) id_cqi_uwc = register_diag_field ( mod_name, 'cqi_uwc', axes(1:3), Time, & 'Updraft ice from uw_conv', 'kg/kg', missing_value=mv) id_cqn_uwc = register_diag_field ( mod_name, 'cqn_uwc', axes(1:3), Time, & 'Updraft liquid drop from uw_conv', '/kg', missing_value=mv) id_hlflx_uwc=register_diag_field (mod_name,'hlflx_uwc',axes(1:3),Time, & 'Liq.wat.pot.temp. flux from uw_conv', 'W/m2', missing_value=mv) id_qtflx_uwc = register_diag_field (mod_name,'qtflx_uwc',axes(1:3),Time, & 'Total water flux from uw_conv', 'W/m2', missing_value=mv) id_prec_uwc = register_diag_field (mod_name,'prec_uwc', axes(1:2), Time, & 'Precipitation rate from uw_conv', 'kg/m2/sec', & interp_method = "conserve_order1" ) id_snow_uwc = register_diag_field (mod_name,'snow_uwc', axes(1:2), Time, & 'Frozen precip. rate from uw_conv', 'kg/m2/sec', & interp_method = "conserve_order1" ) id_cin_uwc = register_diag_field ( mod_name, 'cin_uwc', axes(1:2), Time, & 'CIN from uw_conv', 'm2/s2' ) id_cape_uwc= register_diag_field ( mod_name,'cape_uwc', axes(1:2), Time, & 'CAPE from uw_conv', 'm2/s2' ) id_crh_uwc= register_diag_field ( mod_name,'crh_uwc', axes(1:2), Time, & 'Column RH from uw_conv', '%' ) id_cbmf_uwc = register_diag_field (mod_name,'cbmf_uwc', axes(1:2), Time, & 'Cloud-base mass flux from uw_conv', 'kg/m2/s' ) id_wrel_uwc = register_diag_field (mod_name,'wrel_uwc', axes(1:2), Time, & 'Release level vertical velocity from uw_conv', 'm/s' ) id_ufrc_uwc = register_diag_field (mod_name,'ufrc_uwc', axes(1:2), Time, & 'Release level updraft fraction from uw_conv', 'none' ) id_tke_uwc = register_diag_field ( mod_name, 'tke_uwc', axes(1:2), Time, & 'PBL mean TKE from uw_conv', 'm2/s2' ) id_plcl_uwc = register_diag_field (mod_name,'plcl_uwc', axes(1:2), Time, & 'LCL pressure from uw_conv', 'hPa' ) id_plfc_uwc = register_diag_field (mod_name,'plfc_uwc', axes(1:2), Time, & 'LFC pressure from uw_conv', 'hPa' ) id_plnb_uwc = register_diag_field (mod_name,'plnb_uwc', axes(1:2), Time, & 'LNB pressure from uw_conv', 'hPa' ) id_zinv_uwc = register_diag_field (mod_name,'zinv_uwc', axes(1:2), Time, & 'Inversion pressure from uw_conv', 'm' ) id_pct_uwc = register_diag_field ( mod_name, 'pct_uwc', axes(1:2), Time, & 'Cloud-top pressure from uw_conv', 'hPa' ) id_pcb_uwc = register_diag_field ( mod_name, 'pcb_uwc', axes(1:2), Time, & 'Cloud-base pressure from uw_conv', 'hPa' ) id_cush_uwc = register_diag_field (mod_name,'cush_uwc', axes(1:2), Time, & 'Convective scale height from uw_conv', 'm' ) id_dcin_uwc = register_diag_field (mod_name, 'dcin_uwc', axes(1:2), Time, & 'dCIN/cbmf from uw_conv', 'm2/s2/(kg/m2/s)' ) id_dcape_uwc= register_diag_field (mod_name, 'dcape_uwc', axes(1:2), Time, & 'dCAPE/cbmf from uw_conv', 'm2/s2/(kg/m2/s)' ) id_dwfn_uwc = register_diag_field (mod_name, 'dwfn_uwc', axes(1:2), Time, & 'dwfn/cbmf from uw_conv', '(m2/s2)/(kg/m2/s)' ) id_enth_uwc = register_diag_field (mod_name,'enth_uwc', axes(1:2), Time, & 'Column-integrated enthalpy tendency from uw_conv', 'W/m2' ) id_qtmp_uwc = register_diag_field (mod_name,'qtmp_uwc', axes(1:2), Time, & 'Column-integrated water tendency from uw_conv', 'kg/m2/s' ) id_dting_uwc = register_diag_field (mod_name,'dting_uwc', axes(1:2), Time, & 'Column-integrated heating rate from uw_conv', 'W/m2' ) id_ocode_uwc = register_diag_field (mod_name,'ocode_uwc', axes(1:2), Time, & 'Out code from uw_conv', 'none' ) id_fdp_uwc = register_diag_field ( mod_name, 'fdp_uwc', axes(1:2), Time, & 'Deep convective frequency', 'none', missing_value=mv) if ( do_strat ) then id_qldt_uwc= register_diag_field (mod_name,'qldt_uwc',axes(1:3),Time, & 'Liquid water tendency from uw_conv', 'kg/kg/s', missing_value=mv) id_qidt_uwc= register_diag_field (mod_name,'qidt_uwc',axes(1:3),Time, & 'Ice water tendency from uw_conv', 'kg/kg/s', missing_value=mv) id_qadt_uwc= register_diag_field (mod_name,'qadt_uwc',axes(1:3),Time, & 'CLD fraction tendency from uw_conv', '1/s', missing_value=mv ) id_qndt_uwc= register_diag_field (mod_name,'qndt_uwc',axes(1:3),Time, & 'Cloud droplet number fraction tendency from uw_conv', '#/kg/s', missing_value=mv ) id_qldet_uwc = register_diag_field (mod_name,'qldet_uwc',axes(1:3),Time, & 'ql detrainment', 'kg/kg/s', missing_value=mv) id_qidet_uwc = register_diag_field (mod_name,'qidet_uwc',axes(1:3),Time, & 'qi detrainment', 'kg/kg/s', missing_value=mv) id_qadet_uwc = register_diag_field (mod_name,'qadet_uwc',axes(1:3),Time, & 'qa detrainment', '1/s', missing_value=mv) id_qtdt_uwc= register_diag_field (mod_name,'qtdt_uwc',axes(1:3),Time, & 'Total water tendency from uw_conv', 'kg/kg/s', missing_value=mv) end if if (do_imposing_rad_cooling) then id_tdt_rad_uwc = register_diag_field ( mod_name, 'tdt_rad_uwc', axes(1:3), Time, & 'Idealized radiative temperature tendency from uw_conv', 'K/s', missing_value=mv ) end if !========Option for deep convection======================================= if (do_deep) then id_tdt_pevap_uwd = register_diag_field ( mod_name, 'tdt_pevap_uwd', axes(1:3), Time, & 'Temperature tendency due to pevap from deep_conv', 'K/s', missing_value=mv ) id_qdt_pevap_uwd = register_diag_field ( mod_name, 'qdt_pevap_uwd', axes(1:3), Time, & 'Spec. humidity tendency due to pevap from deep_conv', 'kg/kg/s', missing_value=mv) id_tdt_uwd = register_diag_field ( mod_name, 'tdt_uwd', axes(1:3), Time, & 'Temperature tendency from deep_conv', 'K/s', missing_value=mv ) id_qdt_uwd = register_diag_field ( mod_name, 'qdt_uwd', axes(1:3), Time, & 'Spec. humidity tendency from deep_conv', 'kg/kg/s', missing_value=mv) id_qtdt_uwd= register_diag_field ( mod_name, 'qtdt_uwd', axes(1:3), Time, & 'Total water spec. humidity tendency from deep_conv', 'kg/kg/s', missing_value=mv) id_cmf_uwd = register_diag_field ( mod_name, 'cmf_uwd', axes(1:3), Time, & 'Cloud vert. mass flux from deep_conv', 'kg/m2/s', missing_value=mv) id_wu_uwd = register_diag_field ( mod_name, 'wu_uwd', axes(1:3), Time, & 'Updraft vert. velocity from deep_conv', 'm/s', missing_value=mv) id_cbu_uwd= register_diag_field ( mod_name, 'cbu_uwd', axes(1:3), Time, & 'deep plume buoyancy', 'K', missing_value=mv) id_fer_uwd = register_diag_field ( mod_name, 'fer_uwd', axes(1:3), Time, & 'Fractional entrainment rate from deep_conv', '1/Pa', missing_value=mv) id_fdr_uwd = register_diag_field ( mod_name, 'fdr_uwd', axes(1:3), Time, & 'Fractional detrainment rate from deep_conv', '1/Pa', missing_value=mv) id_fdrs_uwd = register_diag_field (mod_name,'fdrs_uwd', axes(1:3), Time, & 'Detrainment rate for sat. air from deep_conv', '1/Pa', missing_value=mv) id_cqa_uwd = register_diag_field ( mod_name, 'cqa_uwd', axes(1:3), Time, & 'Updraft fraction from deep_conv', 'none', missing_value=mv) id_cql_uwd = register_diag_field ( mod_name, 'cql_uwd', axes(1:3), Time, & 'Updraft liquid from deep_conv', 'kg/kg', missing_value=mv) id_cqi_uwd = register_diag_field ( mod_name, 'cqi_uwd', axes(1:3), Time, & 'Updraft ice from deep_conv', 'kg/kg', missing_value=mv) id_cqn_uwd = register_diag_field ( mod_name, 'cqn_uwd', axes(1:3), Time, & 'Updraft liquid drop from deep_conv', '/kg', missing_value=mv) id_hlflx_uwd=register_diag_field (mod_name,'hlflx_uwd',axes(1:3),Time, & 'Liq.wat.pot.temp. flux from deep_conv', 'W/m2', missing_value=mv) id_qtflx_uwd = register_diag_field (mod_name,'qtflx_uwd',axes(1:3),Time, & 'Total water flux from deep_conv', 'W/m2', missing_value=mv) id_prec_uwd = register_diag_field (mod_name,'prec_uwd', axes(1:2), Time, & 'Precipitation rate from deep_conv', 'kg/m2/sec' ) id_snow_uwd = register_diag_field (mod_name,'snow_uwd', axes(1:2), Time, & 'Frozen precip. rate from deep_conv', 'kg/m2/sec' ) id_cbmf_uwd = register_diag_field (mod_name,'cbmf_uwd', axes(1:2), Time, & 'Cloud-base mass flux from deep_conv', 'kg/m2/s' ) id_dcapedm_uwd= register_diag_field (mod_name, 'dcapedm_uwd', axes(1:2), Time, & 'dCAPE/cbmf from deep_conv', 'm2/s2/(kg/m2/s)' ) id_dwfn_uwd = register_diag_field (mod_name, 'dwfn_uwd', axes(1:2), Time, & 'dwfn/cbmf from deep_conv', '(m2/s2)/(kg/m2/s)' ) id_enth_uwd = register_diag_field (mod_name,'enth_uwd', axes(1:2), Time, & 'Column-integrated enthalpy tendency from deep_conv', 'K/s' ) id_ocode_uwd = register_diag_field (mod_name,'ocode_uwd', axes(1:2), Time, & 'Out code from deep_conv', 'none' ) id_rkm_uwd = register_diag_field (mod_name,'rkm_uwd', axes(1:2), Time, & 'rkm for deep_conv', 'none' ) if ( do_strat ) then id_qldt_uwd= register_diag_field (mod_name,'qldt_uwd',axes(1:3),Time, & 'Liquid water tendency from deep_conv', 'kg/kg/s', missing_value=mv) id_qidt_uwd= register_diag_field (mod_name,'qidt_uwd',axes(1:3),Time, & 'Ice water tendency from deep_conv', 'kg/kg/s', missing_value=mv) id_qadt_uwd= register_diag_field (mod_name,'qadt_uwd',axes(1:3),Time, & 'CLD fraction tendency from deep_conv', '1/s', missing_value=mv ) end if end if !========Option for deep convection======================================= if ( ntracers>0 ) then allocate(id_tracerdt_uwc(ntracers), id_tracerdt_uwc_col(ntracers) ) allocate(id_tracerdtwet_uwc(ntracers), id_tracerdtwet_uwc_col(ntracers)) do nn = 1,ntracers id_tracerdt_uwc(nn) = & register_diag_field (mod_name, trim(tracername(nn))//'dt_uwc', & axes(1:3), Time, & trim(tracername(nn)) //' tendency from uw_conv', & trim(tracer_units(nn))//'/s', missing_value=mv) id_tracerdt_uwc_col(nn) = & register_diag_field (mod_name, trim(tracername(nn))//'dt_uwc_col', & axes(1:2), Time, & trim(tracername(nn)) //' column tendency from uw_conv', & trim(tracer_units(nn))//'*(kg/m2)/s', missing_value=mv) id_tracerdtwet_uwc(nn) = & register_diag_field (mod_name, trim(tracername(nn))//'dt_uwc_wet', & axes(1:3), Time, & trim(tracername(nn)) //' tendency from uw_conv wetdep', & trim(tracer_units(nn))//'/s', missing_value=mv) id_tracerdtwet_uwc_col(nn) = & register_diag_field (mod_name, trim(tracername(nn))//'dt_uwc_wet_col', & axes(1:2), Time, & trim(tracername(nn)) //' column tendency from uw_conv wetdep', & trim(tracer_units(nn))//'*(kg/m2)/s', missing_value=mv) end do end if module_is_initialized = .true. end SUBROUTINE UW_CONV_INIT !##################################################################### !##################################################################### subroutine uw_conv_end call exn_end_k call findt_end_k module_is_initialized = .FALSE. end subroutine uw_conv_end !##################################################################### !##################################################################### SUBROUTINE uw_conv(is, js, Time, tb, qv, ub, vb, pmid, pint,zmid, & !input zint, q, omega, delt, pblht, ustar, bstar, qstar, land, coldT,& !input asol, & !input cush, do_strat, skip_calculation, max_available_cf, & !input tten, qvten, qlten, qiten, qaten, qnten, & !output uten, vten, rain, snow, & !output cmf, hlflx, qtflx, pflx, liq_pflx, ice_pflx, cldql, cldqi, cldqa,cldqn, cbmfo, & !output tracers, trtend, uw_wetdep) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! ! SHALLOW CONVECTION SCHEME ! Described in Bretherton et. al (MWR, April 2004) ! For info contact Ming Zhao: ming.zhao ! ! Inputs: see below ! ! Outputs: see below ! !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC implicit none type(time_type), intent(in) :: Time integer, intent(in) :: is, js real, intent(in) :: delt real, intent(in), dimension(:,:,:) :: ub,vb !wind profile (m/s) real, intent(in), dimension(:,:,:) :: zint !height@model interfaces(m) real, intent(in), dimension(:,:,:) :: pint !pressure@model interfaces(pa) real, intent(in), dimension(:,:,:) :: tb !temperature profile (K) real, intent(in), dimension(:,:,:) :: qv !specific humidity profile (kg/kg) real, intent(in), dimension(:,:,:,:) :: q !specific humidity profile (kg/kg) real, intent(in), dimension(:,:,:) :: pmid !pressure@model mid-levels (pa) real, intent(in), dimension(:,:,:) :: zmid !height@model mid-levels (m) real, intent(in), dimension(:,:,:) :: omega !omega (Pa/s) real, intent(in), dimension(:,:) :: land !land fraction real, intent(in), dimension(:,:,:) :: max_available_cf ! largest ! realizable value for uw cld frac ! after accounting for deep cld frac logical,intent(in), dimension(:,:) :: skip_calculation ! do not ! calculate where .true. logical,intent(in) :: do_strat !logical flag logical,intent(in), dimension(:,:) :: coldT !logical flag real, intent(in), dimension(:,:) :: pblht, ustar, bstar, qstar !pbl height... real, intent(inout), dimension(:,:) :: cush ! convective scale height (m) type(aerosol_type), intent (in) :: asol real, intent(out), dimension(:,:,:) :: tten,qvten ! T,qv tendencies real, intent(out), dimension(:,:,:) :: qlten,qiten,qaten,qnten ! q tendencies real, intent(out), dimension(:,:,:) :: uten,vten ! u,v tendencies real, intent(out), dimension(:,:,:) :: cldql,cldqi,cldqa, cldqn!in-updraft q real, intent(out), dimension(:,:,:) :: cmf ! mass flux at level above layer (kg/m2/s) real, intent(out), dimension(:,:,:) :: pflx ! precipitation flux removed from a layer real, intent(out), dimension(:,:,:) :: liq_pflx ! liq precipitation flux removed from a layer real, intent(out), dimension(:,:,:) :: ice_pflx ! solid precipitation flux removed from a layer real, intent(out), dimension(:,:,:) :: hlflx ! theta_l flux real, intent(out), dimension(:,:,:) :: qtflx ! qt flux real, intent(out), dimension(:,:) :: rain, snow real, intent(inout), dimension(:,:) :: cbmfo ! cloud-base mass flux real, intent(in), dimension(:,:,:,:) :: tracers ! env. tracers real, intent(out), dimension(:,:,:,:) :: trtend ! calculated tracer tendencies real, intent(out), dimension(:,:,:) :: uw_wetdep ! calculated wet depostion for tracers integer i, j, k, kl, klm, nk, naer, na, n real rhos0j real hlsrc, thcsrc, qctsrc, tmp, lofactor, crh_th real zsrc, psrc, cbmf_shallow, cbmf_old, cbmf_deep, rkm_sh1, rkm_dp, cbmf_dp_frac, dcrh, dcrh0, dpsum real, dimension(size(tb,1),size(tb,2)) :: & plcl, & ! pressure of lifting condensation level (Pa) plfc, & ! pressure of level of free convection (Pa) plnb, & ! pressure of level of neutral buoyancy (Pa) cino, & ! cin (m2/s2) capeo, & ! cape(m2/s2) tkeo, & ! tke (m2/s2) wrelo, & ! release level vertical velocity (m/s) ufrco, & ! cloud-base updraft fraction zinvo, & ! surface driven mixed-layer height denth, & dqtmp, & dting, & dcino, & ! dcin (m2/s2) dcapeo, & ! dcape(m2/s2) dwfno, & ! dwfn(m2/s2) ocode, & xhlsrc, & xqtsrc, & crho, & rkm_d, & fdp real, dimension(size(tb,1),size(tb,2),size(tb,3)) :: wuo,fero,fdro,fdrso, tten_pevap, qvten_pevap real, dimension(size(tb,1),size(tb,2),size(tb,3)) :: qldet, qidet, qadet, cfq, peo, hmo, hms, abu real, dimension(size(tb,1),size(tb,2)) :: scale_uw real :: qtin, dqt, temp_1 !========Option for deep convection======================================= real, dimension(size(tb,1),size(tb,2),size(tb,3)) :: uten_d, vten_d, tten_d, & qvten_d, qlten_d, qiten_d, qaten_d, qnten_d, cmf_d, cbu_d, pflx_d, hlflx_d, qtflx_d, qtten_d, & wuo_d, fero_d, fdro_d, fdrso_d, cldql_d, cldqi_d, cldqa_d, cldqn_d, tten_pevap_d, qvten_pevap_d real, dimension(size(tb,1),size(tb,2)) :: rain_d, snow_d, dcapedm_d, dwfn_d, denth_d, dting_d, dqtmp_d, cbmf_d !========Option for deep convection======================================= real, dimension(size(tb,3)) :: am1, am2, am3, am4, am5, qntmp real, dimension(size(tb,1),size(tb,2),size(tb,3)) :: pmass ! layer mass (kg/m2) real, dimension(size(tb,1),size(tb,2)) :: tempdiag ! temporary diagnostic variable real, dimension(size(tracers,1),size(tracers,2),size(tracers,3),size(tracers,4)) :: trwet ! calculated tracer wet deposition tendencies integer imax, jmax, kmax integer kd, ntracers integer ktop_tmp, kbot_tmp real :: tten_intg, qvten_intg real, dimension(size(tb,3)) :: tten_tmp, qvten_tmp real, dimension(size(tb,1),size(tb,2),size(tb,3)) :: tten_rad logical used type(sounding) :: sd, sd1 type(adicloud) :: ac, ac1 type(cclosure) :: cc, cc1 type(cplume) :: cp, cp1 type(ctend) :: ct, ct1 type(cpnlist) :: cpn,dpn type(deepc) :: dpc integer :: ier character(len=256) :: ermesg kd = size(tracers,3) ntracers = size(tracers,4) call sd_init_k(kd,ntracers,sd); call sd_init_k(kd,ntracers,sd1); call ac_init_k(kd,ac); call ac_init_k(kd,ac1); call cp_init_k(kd,ntracers,cp) call cp_init_k(kd,ntracers,cp1) call ct_init_k(kd,ntracers,ct) call ct_init_k(kd,ntracers,ct1) !pack namelist parameters into plume and closure structure cpn % do_qctflx_zero = do_qctflx_zero cpn % do_detran_zero = do_detran_zero cpn % rle = rle cpn % rpen = rpen cpn % rmaxfrac = rmaxfrac cpn % wmin = wmin cpn % rbuoy = rbuoy cpn % rdrag = rdrag cpn % frac_drs = frac_drs cpn % bigc = bigc cpn % auto_th0 = auto_th0 cpn % deltaqc0 = deltaqc0 cpn % do_pdfpcp = do_pdfpcp cpn % do_pmadjt = do_pmadjt cpn % do_emmax = do_emmax cpn % do_pnqv = do_pnqv cpn % emfrac_max= emfrac_max cpn % auto_rate = auto_rate cpn % tcrit = tcrit cpn % cldhgt_max= cldhgt_max cpn % do_ice = do_ice cpn % do_ppen = do_ppen cpn % do_pevap = do_pevap cpn % hcevap = hcevap cpn % cfrac = cfrac cpn % mixing_assumption= mixing_assumption cpn % mp_choice = mp_choice cpn % Nl_land = Nl_land cpn % Nl_ocean = Nl_ocean cpn % qi_thresh = qi_thresh cpn % r_thresh = r_thresh cpn % peff_l = peff_l cpn % peff_i = peff_i cpn % t00 = t00 cpn % rh0 = rh0 cpn % do_forcedlifting= do_forcedlifting cpn % atopevap = atopevap cpn % wtwmin_ratio = wmin_ratio*wmin_ratio cpn % do_auto_aero = do_auto_aero cpn % rad_crit = rad_crit cpn % wrel_min = wrel_min cpn % do_weffect = do_weffect cpn % weffect = weffect cpn % use_online_aerosol = use_online_aerosol if (ntracers > 0) then allocate ( cpn%tracername (ntracers) ) allocate ( cpn%tracer_units (ntracers) ) allocate ( cpn%wetdep (ntracers) ) cpn%tracername(:) = tracername(:) cpn%tracer_units(:) = tracer_units(:) cpn%wetdep(:)%scheme = wetdep(:)%scheme cpn%wetdep(:)%Henry_constant = wetdep(:)%Henry_constant cpn%wetdep(:)%Henry_variable = wetdep(:)%Henry_variable cpn%wetdep(:)%frac_in_cloud = wetdep(:)%frac_in_cloud cpn%wetdep(:)%alpha_r = wetdep(:)%alpha_r cpn%wetdep(:)%alpha_s = wetdep(:)%alpha_s cpn%wetdep(:)%Lwetdep = wetdep(:)%Lwetdep cpn%wetdep(:)%Lgas = wetdep(:)%Lgas cpn%wetdep(:)%Laerosol = wetdep(:)%Laerosol cpn%wetdep(:)%Lice = wetdep(:)%Lice allocate ( dpn%tracername (ntracers) ) allocate ( dpn%tracer_units (ntracers) ) allocate ( dpn%wetdep (ntracers) ) dpn%tracername(:) = tracername(:) dpn%tracer_units(:) = tracer_units(:) dpn%wetdep(:)%scheme = wetdep(:)%scheme dpn%wetdep(:)%Henry_constant = wetdep(:)%Henry_constant dpn%wetdep(:)%Henry_variable = wetdep(:)%Henry_variable dpn%wetdep(:)%frac_in_cloud = wetdep(:)%frac_in_cloud dpn%wetdep(:)%alpha_r = wetdep(:)%alpha_r dpn%wetdep(:)%alpha_s = wetdep(:)%alpha_s dpn%wetdep(:)%Lwetdep = wetdep(:)%Lwetdep dpn%wetdep(:)%Lgas = wetdep(:)%Lgas dpn%wetdep(:)%Laerosol = wetdep(:)%Laerosol dpn%wetdep(:)%Lice = wetdep(:)%Lice endif call cpn_copy(cpn, dpn) cc % igauss = igauss cc % rkfre = rkfre cc % rmaxfrac = rmaxfrac cc % wcrit_min = wcrit_min cc % rbuoy = rbuoy cc % tau_sh = tau_sh !========Option for deep convection======================================= dpc % rkm_dp1 = rkm_dp1 dpc % rkm_dp2 = rkm_dp2 dpc % cbmf_dp_frac1 = cbmf_dp_frac1 dpc % cbmf_dp_frac2 = cbmf_dp_frac2 dpc % crh_th_ocean = crh_th_ocean dpc % crh_th_land = crh_th_land dpc % cape_th = cape_th dpc % tau_dp = tau_dp dpc % mixing_assumption_d = mixing_assumption_d dpc % do_ppen_d = do_ppen_d dpc % rpen_d = rpen_d dpc % do_pevap_d = do_pevap_d dpc % cfrac_d = cfrac_d dpc % hcevap_d = hcevap_d dpc % frac_limit_d = frac_limit_d dpc % dcapedm_th = dcapedm_th dpc % do_forcedlifting_d = do_forcedlifting_d dpc % lofactor_d = lofactor_d dpc % auto_th0_d = auto_th0_d dpc % tcrit_d = tcrit_d !========Option for deep convection======================================= imax = size( tb, 1 ) jmax = size( tb, 2 ) kmax = size( tb, 3 ) sd % kmax=kmax kl=kmax-1 klm=kl-1 !initialize 3D variables outside the loop tten=0.; qvten=0.; qlten=0.; qiten=0.; qaten=0.; qnten=0.; uten=0.; vten =0.; rain =0.; snow =0.; plcl =0.; plfc=0.; plnb=0.; cldqa=0.; cldql=0.; cldqi=0.; cldqn=0.; hlflx=0.; qtflx=0.; pflx=0.; am1=0.; am2=0.; am3=0.; am4=0.; tten_pevap=0.; qvten_pevap=0.; ice_pflx = 0. ; liq_pflx = 0. cino=0.; capeo=0.; tkeo=0.; wrelo=0.; ufrco=0.; zinvo=0.; wuo=0.; peo=0.; fero=0.; fdro=0.; fdrso=0.; cmf=0.; denth=0.; dqtmp=0.; ocode=0; dcapeo=0.; dcino=0.; dwfno=0.; xhlsrc=0.; xqtsrc=0.; fdp=0.; trtend=0.; qldet=0.; qidet=0.; qadet=0.; crho=0.; hmo=0.; hms=0.; abu=0.; trwet = 0. dting = 0. naer = size(asol%aerosol,4) !========Option for deep convection======================================= if (do_deep) then tten_d=0.; qvten_d=0.; qlten_d=0.; qiten_d=0.; qaten_d=0.; qnten_d=0.; uten_d=0.; vten_d =0.; rain_d =0.; snow_d =0.; qtten_d=0.; cldqa_d=0.; cldql_d=0.; cldqi_d=0.; cldqn_d=0.; hlflx_d=0.; qtflx_d=0.; pflx_d=0.; wuo_d=0.; fero_d=0.; fdro_d=0.; fdrso_d=0.; cmf_d=0.; cbu_d=0.; denth_d=0.; dting_d=0.; dqtmp_d=0.; cbmf_d=0.; dcapedm_d=0.; dcino=0.; dwfn_d=0.; tten_pevap_d=0.; qvten_pevap_d=0.; rkm_d=0.; end if !========Option for deep convection======================================= do j = 1, jmax do i=1, imax do k=1,kmax pmass(i,j,k) = (pint(i,j,k+1) - pint(i,j,k))/GRAV enddo !relaxation TKE back to 0 with time-scale of disscale !tkeavg = ustar(i,j)*bstar(i,j)*disscale !dissipate tke with length-scale of disscale !tkeavg=(ustar(i,j)*bstar(i,j)*disscale)**(2./3.) !below following Holtslag and Boville 1993 if (pblht(i,j).lt.0.) then temp_1=0.0 elseif (pblht(i,j).gt.5000.) then temp_1=5000. else temp_1=pblht(i,j) endif temp_1=ustar(i,j)**3.+0.6*ustar(i,j)*bstar(i,j)*temp_1 if (temp_1 .gt. 0.) temp_1 = 0.5*temp_1**(2./3.) tkeo(i,j) = MAX (tkemin, temp_1) if (do_gust_cv) then if (cbmfo(i,j)>0) then tkeo(i,j) = tkeo(i,j)+(gustmax*sqrt(cbmfo(i,j)/(gustconst + cbmfo(i,j))))**2. endif endif if (skip_calculation(i,j)) then ocode(i,j) = 6 go to 100 endif call clearit(ac, cc, cp, ct, cp1, ct1); ! restrict grid-box area available to shallow convection to that which ! is not involved with deep convection cp%maxcldfrac = minval(max_available_cf(i,j,:)) cc%maxcldfrac = cp%maxcldfrac cc%scaleh = cush(i,j); cush(i,j) = -1.; if(cc%scaleh.le.0.0) cc%scaleh=1000. am1(:) = 0.; am2(:) = 0.; am3(:) = 0.; am4(:) = 0.; am5(:) = 0.; do k=1,kmax tmp=1. / (zint(i,j,k)-zint(i,j,k+1)) * 1.0e9 * 1.0e-12 if(use_online_aerosol) then do na = 1,naer if(asol%aerosol_names(na) == 'so4' .or. & asol%aerosol_names(na) == 'so4_anthro' .or. & asol%aerosol_names(na) == 'so4_natural') then am1(k)=am1(k)+asol%aerosol(i,j,k,na)*tmp else if(asol%aerosol_names(na) == 'omphilic' .or. & asol%aerosol_names(na) == 'omphobic') then am4(k)=am4(k)+asol%aerosol(i,j,k,na)*tmp else if(asol%aerosol_names(na) == 'bcphilic' .or. & asol%aerosol_names(na) == 'bcphobic' .or. & asol%aerosol_names(na) == 'dust1' .or. & asol%aerosol_names(na) == 'dust2' .or. & asol%aerosol_names(na) == 'dust3' ) then am2(k)=am2(k)+asol%aerosol(i,j,k,na)*tmp else if(asol%aerosol_names(na) == 'seasalt1' .or. & asol%aerosol_names(na) == 'seasalt2') then am3(k)=am3(k)+asol%aerosol(i,j,k,na)*tmp else if(asol%aerosol_names(na) == 'seasalt3' .or. & asol%aerosol_names(na) == 'seasalt4' .or. & asol%aerosol_names(na) == 'seasalt5' ) then am5(k)=am5(k)+asol%aerosol(i,j,k,na)*tmp end if end do am2(k)=am2(k)+am3(k)+am4(k) if(.not. use_sub_seasalt) am3(k)=am3(k)+am5(k) else am1(k)= asol%aerosol(i,j,k,2)*tmp am2(k)= asol%aerosol(i,j,k,1)*tmp am3(k)= sea_salt_scale*asol%aerosol(i,j,k,5)*tmp am4(k)= om_to_oc*asol%aerosol(i,j,k,3)*tmp endif end do !========Pack column properties into a sounding structure==================== if (do_qn) then qntmp(:)=q(i,j,:,nqn) else qntmp(:)=0. end if call pack_sd_k(land(i,j), coldT(i,j), delt, pmid(i,j,:), pint(i,j,:), & zmid(i,j,:), zint(i,j,:), ub(i,j,:), vb(i,j,:), tb(i,j,:), & q(i,j,:,nqv), q(i,j,:,nql), q(i,j,:,nqi), q(i,j,:,nqa), qntmp, & am1(:), am2(:), am3(:), am4(:), tracers(i,j,:,:), sd, Uw_p) !========Finite volume intepolation========================================== call extend_sd_k(sd, pblht(i,j),do_ice, Uw_p) sd%tke = tkeo(i,j) zinvo (i,j) = sd%zinv !========Find source air, and do adiabatic cloud lifting====================== zsrc =sd%zs (1) psrc =sd%ps (1) thcsrc=sd%thc(1) qctsrc=sd%qct(1) hlsrc =sd%hl (1) rkm_sh1=rkm_sh if (do_lands) then !wstar = (ustar(i,j)*bstar(i,j)*pblht(i,j))**(1./3.) cpn % auto_th0 = auto_th0 * (1. + landfact_m * sd%land) call qt_parcel_k (sd%qs(1), qstar(i,j), pblht(i,j), sd%tke, sd%land, gama, & pblht0, tke0, lofactor0, lochoice, qctsrc, lofactor) rkm_sh1 = rkm_sh * lofactor end if call adi_cloud_k(zsrc, psrc, hlsrc, thcsrc, qctsrc, sd, Uw_p, do_fast, do_ice, ac) ac % usrc = sd%u(sd%ktoppbl) ac % vsrc = sd%v(sd%ktoppbl) if (ac%plfc.eq.0) ac%plfc=psrc if (ac%plnb.eq.0) ac%plnb=psrc plcl (i,j) = ac%plcl plfc (i,j) = ac%plfc plnb (i,j) = ac%plnb cino (i,j) = ac%cin capeo(i,j) = ac%cape xhlsrc(i,j)= ac%hlsrc; xqtsrc(i,j)= ac%qctsrc; crho(i,j) = sd%crh; do k = 1,kmax nk = kmax+1-k hmo (i,j,nk) = sd%hm(k); hms (i,j,nk) = sd%hms(k); abu (i,j,nk) = ac%buo(k); end do if (do_fast) then ! if (ac%klcl.eq.0 .or. ac%plcl.gt.sd%ps(1) .or. ac%plcl.lt.20000.) then if (ac%klcl.eq.0 .or. ac%plcl.eq.sd%ps(1) .or. ac%plcl.lt.20000.) then ocode(i,j)=1; goto 100 !cycle; end if if (ac%plfc.lt.500.) then ocode(i,j)=2; goto 100 !cycle; end if end if !========Cumulus closure to determine cloud base mass flux=================== cbmf_old=cbmfo(i,j); cc%cbmf=cbmf_old; if (iclosure.eq.0) then call cclosure_bretherton(sd%tke, cpn, sd, Uw_p, ac, cc) else if (iclosure.eq.1) then call cclosure_implicit(sd%tke, cpn, sd, Uw_p, ac, cc, delt, rkm_sh1, & do_coldT, sd1, ac1, cc1, cp, ct, ier, ermesg) if (ier /= 0) then call error_mesg ('subroutine uw_conv iclosure=1 ', ermesg, FATAL) endif else if (iclosure.eq.2) then call cclosure_relaxwfn(sd%tke, cpn, sd, Uw_p, ac, cc, cp, ct, delt, & rkm_sh1, do_coldT, sd1, ac1, cc1, cp1, ct1, ier, ermesg) if (ier /= 0) then call error_mesg ('subroutine uw_conv iclosure=2 ', ermesg, FATAL) endif end if cbmfo(i,j) = cc%cbmf wrelo(i,j) = cc%wrel ufrco(i,j) = cc%ufrc if (.not.do_fast) then if (ac%klcl.eq.0 .or. ac%plcl.eq.sd%ps(1) .or. ac%plcl.lt.20000.) then ! if (ac%klcl.eq.0 .or. ac%plcl.lt.20000.) then ocode(i,j)=1; goto 100 !cycle; end if if (ac%plfc.lt.500.) then ocode(i,j)=2; goto 100 !cycle; end if end if if(cc%cbmf.lt.1.e-6 .or. cc%wrel.eq.0.) then ocode(i,j)=3; goto 100 !cycle; end if !========Do shallow cumulus plume calculation================================ cpn%isdeep=.false. cbmf_shallow = cc%cbmf ! - cbmf_deep cpn%do_ppen=do_ppen cpn%rpen =rpen call cumulus_plume_k(cpn, sd, ac, cp, rkm_sh1, cbmf_shallow, cc%wrel, cc%scaleh, Uw_p, ier, ermesg) if (ier /= 0) then call error_mesg ('subroutine uw_conv', ermesg, FATAL) endif if(cp%ltop.lt.cp%krel+2 .or. cp%let.le.cp%krel+1) then ocode(i,j)=4; goto 100 !cycle; end if if(cp%cldhgt.ge.cldhgt_max) then ocode(i,j)=5; goto 100 !cycle; end if if (cpn%isdeep .EQV. .true.) then fdp(i,j) = 1 else fdp(i,j) = 0 end if cush(i,j)=cp%cush !========Calculate cumulus produced tendencies=============================== call cumulus_tend_k(cpn, sd, Uw_p, cp, ct, do_coldT) !========Unpack convective tendencies======================================== do k = 1,cp%ltop nk = kmax+1-k uten (i,j,nk) = ct%uten (k) vten (i,j,nk) = ct%vten (k) qlten (i,j,nk) = ct%qlten(k) qiten (i,j,nk) = ct%qiten(k) qaten (i,j,nk) = ct%qaten(k) qnten (i,j,nk) = ct%qnten(k) qldet (i,j,nk) = ct%qldet(k) qidet (i,j,nk) = ct%qidet(k) qadet (i,j,nk) = ct%qadet(k) qvten (i,j,nk) = ct%qvten(k) pflx (i,j,nk) = ct%pflx (k) ice_pflx(i,j,nk) = cp%ppti(k) liq_pflx(i,j,nk) = cp%pptr(k) tten (i,j,nk) = ct%tten (k) rhos0j = sd%ps(k)/(rdgas*0.5*(cp%thvbot(k+1)+cp%thvtop(k))*sd%exners(k)) hlflx(i,j,nk) = ct%hlflx(k) qtflx (i,j,nk) = rhos0j*HLv*ct%qctflx(k) tten_pevap (i,j,nk) = ct%tevap (k) qvten_pevap(i,j,nk) = ct%qevap (k) cldqa (i,j,nk) = cp%ufrc(k) cldql (i,j,nk) = cp%qlu(k) cldqi (i,j,nk) = cp%qiu(k) cldqn (i,j,nk) = cp%qnu(k) cmf (i,j,nk) = cp%umf(k) wuo (i,j,nk) = cp%wu (k) peo (i,j,nk) = cp%peff(k) fero (i,j,nk) = cp%fer(k) fdro (i,j,nk) = cp%fdr(k) fdrso (i,j,nk) = cp%fdrsat(k)*cp%umf(k) enddo ! make sure the predicted tracer tendencies do not produce negative ! tracers due to convective tendencies. if necessary, adjust the ! tendencies. call check_tracer_realizability (kmax, size(trtend,4), delt, & cp%tr, ct%trten, ct%trwet) do k = 1,cp%ltop nk = kmax+1-k do n = 1, size(trtend,4) trtend(i,j,nk,n) = ct%trten(k,n) + ct%trwet(k,n) trwet(i,j,nk,n) = ct%trwet(k,n) enddo enddo snow (i,j) = ct%snow rain (i,j) = ct%rain denth (i,j) = ct%denth dqtmp (i,j) = ct%dqtmp dting (i,j) = ct%dting !========Option for deep convection======================================= 100 if (do_deep) then cbmf_deep = 0. rkm_dp = 0. tmp = max(min (sd%crh, 1.0), 0.0) crh_th = sd%land*dpc%crh_th_land+(1.-sd%land)*dpc%crh_th_ocean dcrh = tmp - crh_th dcrh0 = 1.0001-crh_th if (dcrh .gt. 0) then dcrh = dcrh/dcrh0; dcrh = dcrh**norder rkm_dp = dpc%rkm_dp1 + dcrh * (dpc%rkm_dp2 -dpc%rkm_dp1) cbmf_dp_frac = dpc%cbmf_dp_frac1+ dcrh * (dpc%cbmf_dp_frac2-dpc%cbmf_dp_frac1) cbmf_deep = 1. !%cbmf_dp_frac * cc%cbmf lofactor = 1. - sd%land * (1. - dpc%lofactor_d) if (do_lod_rkm) then rkm_dp = rkm_dp * lofactor elseif (do_lod_cfrac) then dpc % cfrac_d= dpc % cfrac_d * lofactor elseif (do_lod_tcrit) then dpc % tcrit_d= dpc % tcrit_d * lofactor end if end if rkm_d(i,j) = rkm_dp; dpn % do_ppen = dpc % do_ppen_d dpn % do_pevap = dpc % do_pevap_d dpn % cfrac = dpc % cfrac_d dpn % hcevap = dpc % hcevap_d dpn % tcrit = dpc % tcrit_d dpn % auto_th0 = dpc % auto_th0_d dpn % mixing_assumption = dpc % mixing_assumption_d dpn % do_forcedlifting = dpc % do_forcedlifting_d if (idpchoice.eq.0) then call dpconv0(dpc, dpn, Uw_p, sd, ac, cc, cp, ct, do_coldT, do_ice, & rkm_dp, cbmf_deep, cp1, ct1, ocode(i,j), ier, ermesg) else if (idpchoice.eq.1) then call dpconv1(dpc, dpn, Uw_p, sd, ac, cc, cp, ct, do_coldT, do_ice, & rkm_dp, cbmf_deep, sd1, ac1, cp1, ct1, ocode(i,j), dcapedm_d(i,j), ier, ermesg) else if (idpchoice.eq.2) then call dpconv2(dpc, dpn, Uw_p, sd, ac, cc, cp, ct, do_coldT, do_ice, & rkm_dp, cbmf_deep, sd1, ac1, cp1, ct1, ocode(i,j), ier, ermesg) end if if (ier /= 0) then call error_mesg ('uw_conv calling dpconv', ermesg, FATAL) endif if(ocode(i,j).ge.6) cycle; do k = 1,kmax !cp1%ltop nk = kmax+1-k uten_d (i,j,nk) = ct1%uten (k) vten_d (i,j,nk) = ct1%vten (k) qlten_d (i,j,nk) = ct1%qlten(k) qiten_d (i,j,nk) = ct1%qiten(k) qaten_d (i,j,nk) = ct1%qaten(k) qnten_d (i,j,nk) = ct1%qnten(k) qvten_d (i,j,nk) = ct1%qvten(k) qtten_d (i,j,nk) = ct1%qctten(k) pflx_d (i,j,nk) = ct1%pflx (k) tten_d (i,j,nk) = ct1%tten (k) hlflx_d (i,j,nk) = ct1%hlflx(k) qtflx_d (i,j,nk) = ct1%qctflx(k) cldqa_d (i,j,nk) = cp1%ufrc(k) cldql_d (i,j,nk) = cp1%qlu(k) cldqi_d (i,j,nk) = cp1%qiu(k) cldqn_d (i,j,nk) = cp1%qnu(k) cmf_d (i,j,nk) = cp1%umf(k) + cp1%emf(k) cbu_d (i,j,nk) = cp1%buo(k) tten_pevap_d (i,j,nk) = ct1%tevap (k) qvten_pevap_d(i,j,nk) = ct1%qevap (k) wuo_d (i,j,nk) = cp1%wu (k) fero_d (i,j,nk) = cp1%fer(k) fdro_d (i,j,nk) = cp1%fdr(k) fdrso_d (i,j,nk) = cp1%fdrsat(k)*cp1%fdr(k)*cp1%umf(k) enddo snow_d (i,j) = ct1%snow rain_d (i,j) = ct1%rain cbmf_d (i,j) = cbmf_deep denth_d (i,j) = ct1%denth dting_d (i,j) = ct1%dting dqtmp_d (i,j) = ct1%dqtmp !dwfn_d (i,j) = cc%dwfn !========Option for deep convection======================================= uten (i,j,:) = uten (i,j,:) + uten_d (i,j,:) vten (i,j,:) = vten (i,j,:) + vten_d (i,j,:) qlten (i,j,:) = qlten (i,j,:) + qlten_d (i,j,:) qiten (i,j,:) = qiten (i,j,:) + qiten_d (i,j,:) qaten (i,j,:) = qaten (i,j,:) + qaten_d (i,j,:) qnten (i,j,:) = qnten (i,j,:) + qnten_d (i,j,:) qvten (i,j,:) = qvten (i,j,:) + qvten_d (i,j,:) pflx (i,j,:) = pflx (i,j,:) + pflx_d (i,j,:) tten (i,j,:) = tten (i,j,:) + tten_d (i,j,:) hlflx (i,j,:) = hlflx (i,j,:) + hlflx_d (i,j,:) qtflx (i,j,:) = qtflx (i,j,:) + qtflx_d (i,j,:) cmf (i,j,:) = cmf (i,j,:) + cmf_d (i,j,:) tten_pevap (i,j,:)=tten_pevap (i,j,:) + tten_pevap_d (i,j,:) qvten_pevap(i,j,:)=qvten_pevap(i,j,:) + qvten_pevap_d(i,j,:) !wuo (i,j,:) = wuo (i,j,:) !fero (i,j,:) = fero (i,j,:) !fdro (i,j,:) = fdro (i,j,:) !fdrso (i,j,:) = fdrso (i,j,:) !do n = 1, size(trtend,4) ! trtend(i,j,:,n) = trtend(i,j,:,n) !enddo snow (i,j) = snow (i,j) + snow_d (i,j) rain (i,j) = rain (i,j) + rain_d (i,j) denth (i,j) = denth (i,j) + denth_d (i,j) dting (i,j) = dting (i,j) + dting_d (i,j) dqtmp (i,j) = dqtmp (i,j) + dqtmp_d (i,j) !cbmfo (i,j) = cc%cbmf !dwfno (i,j) = cc%dwfn end if !========Option for deep convection======================================= if (do_no_uw_conv) then uten (i,j,:)=0.; vten (i,j,:)=0.; tten (i,j,:)=0.; qvten(i,j,:)=0.; cmf (i,j,:)=0.; qlten(i,j,:)=0.; qiten(i,j,:)=0.; qaten(i,j,:)=0.; qnten(i,j,:)=0.; rain (i,j) =0.; snow(i,j)=0.; endif if (do_imposing_rad_cooling) then tten_rad (i,j,:)=0; do k = 1,sd%kmax nk = kmax+1-k if (sd%t(k)>t_thresh) then tten_rad (i,j,nk) = cooling_rate/86400. else tten_rad (i,j,nk) = (t_strato-sd%t(k))/(tau_rad*86400.) end if enddo end if if (do_imposing_cooling_drying) then kbot_tmp=1; ktop_tmp=sd%kmax; do k=1,sd%kmax if (sd%p(k)>=7500) then ktop_tmp=k end if if (sd%p(k)>=85000) then kbot_tmp=k end if enddo tten_tmp (:)=0; qvten_tmp(:)=0; do k = kbot_tmp,ktop_tmp if (sd%p(k)>pres_min .and. sd%p(k)<=pres_max) then tten_tmp (k)=tdt_rate/86400. qvten_tmp(k)=qvdt_rate/86400. end if enddo ! tten_intg=0. ! qvten_intg=0. ! dpsum =0. ! do k = kbot_tmp,ktop_tmp ! tten_intg = tten_intg + tten_tmp (k)*sd%dp(k) ! qvten_intg = qvten_intg + qvten_tmp(k)*sd%dp(k) ! dpsum = dpsum + sd%dp(k) ! end do ! do k = kbot_tmp,ktop_tmp ! tten_tmp(k) = tten_tmp(k) - tten_intg / dpsum ! qvten_tmp(k)= qvten_tmp(k) - qvten_intg /dpsum ! end do do k = 1,kmax nk = kmax+1-k tten_rad (i,j,nk) = tten_rad (i,j,nk) + tten_tmp (k) end do end if enddo enddo call sd_end_k(sd) call sd_end_k(sd1) call ac_end_k(ac) call ac_end_k(ac1) call cp_end_k(cp) call cp_end_k(cp1) call ct_end_k(ct) call ct_end_k(ct1) if (_ALLOCATED ( cpn%tracername )) deallocate ( cpn%tracername ) if (_ALLOCATED ( cpn%tracer_units )) deallocate ( cpn%tracer_units ) if (_ALLOCATED ( cpn%wetdep )) deallocate ( cpn%wetdep ) if (_ALLOCATED ( dpn%tracername )) deallocate ( dpn%tracername ) if (_ALLOCATED ( dpn%tracer_units )) deallocate ( dpn%tracer_units ) if (_ALLOCATED ( dpn%wetdep )) deallocate ( dpn%wetdep ) if (.not.do_uwcmt) then uten=0.; vten=0.; end if if ( prevent_unreasonable ) then scale_uw=HUGE(1.0) do k=1,kmax do j=1,jmax do i=1,imax if ((q(i,j,k,nqa) + qaten(i,j,k)*delt) .lt. 0. .and. (qaten(i,j,k).ne.0.)) then qaten(i,j,k) = -1.*q(i,j,k,nqa)/delt end if if ((q(i,j,k,nqa) + qaten(i,j,k)*delt) .gt. 1. .and. (qaten(i,j,k).ne.0.)) then qaten(i,j,k)= (1. - q(i,j,k,nqa))/delt end if if ((q(i,j,k,nql) + qlten(i,j,k)*delt) .lt. 0. .and. (qlten(i,j,k).ne.0.)) then tten (i,j,k) = tten(i,j,k) -(q(i,j,k,nql)/delt+qlten(i,j,k))*HLv/Cp_Air qvten(i,j,k) = qvten(i,j,k)+(q(i,j,k,nql)/delt+qlten(i,j,k)) qlten(i,j,k) = qlten(i,j,k)-(q(i,j,k,nql)/delt+qlten(i,j,k)) end if if ((q(i,j,k,nqi) + qiten(i,j,k)*delt) .lt. 0. .and. (qiten(i,j,k).ne.0.)) then tten (i,j,k) = tten(i,j,k) -(q(i,j,k,nqi)/delt+qiten(i,j,k))*HLs/Cp_Air qvten(i,j,k) = qvten(i,j,k)+(q(i,j,k,nqi)/delt+qiten(i,j,k)) qiten(i,j,k) = qiten(i,j,k)-(q(i,j,k,nqi)/delt+qiten(i,j,k)) end if if (do_qn) then if ((q(i,j,k,nqn) + qnten(i,j,k)*delt) .lt. 0. .and. (qnten(i,j,k).ne.0.)) then qnten(i,j,k) = qnten(i,j,k)-(q(i,j,k,nqn)/delt+qnten(i,j,k)) end if endif !rescaling to prevent negative specific humidity for each grid point if (do_rescale) then qtin = q(i,j,k,nqv) dqt = qvten(i,j,k) * delt if ( dqt.lt.0 .and. qtin+dqt.lt.1.e-10 ) then temp_1 = max( 0.0, -(qtin-1.e-10)/dqt ) else temp_1 = 1.0 endif !scaling factor for each column is the minimum value within that column scale_uw(i,j) = min( temp_1, scale_uw(i,j)) endif enddo enddo enddo ! where ((tracers(:,:,:,:) + trtend(:,:,:,:)*delt) .lt. 0.) ! trtend(:,:,:,:) = -tracers(:,:,:,:)/delt ! end where if (do_rescale) then !scale tendencies do k=1,kmax do j=1,jmax do i=1,imax uten (i,j,k) = scale_uw(i,j) * uten (i,j,k) vten (i,j,k) = scale_uw(i,j) * vten (i,j,k) tten (i,j,k) = scale_uw(i,j) * tten (i,j,k) qvten(i,j,k) = scale_uw(i,j) * qvten(i,j,k) qlten(i,j,k) = scale_uw(i,j) * qlten(i,j,k) qiten(i,j,k) = scale_uw(i,j) * qiten(i,j,k) qaten(i,j,k) = scale_uw(i,j) * qaten(i,j,k) if (do_qn) qnten(i,j,k) = scale_uw(i,j) * qnten(i,j,k) if (k.eq.kmax) then rain(i,j) = scale_uw(i,j) * rain(i,j) snow(i,j) = scale_uw(i,j) * snow(i,j) endif end do end do end do end if endif do k=1,kmax do j=1,jmax do i=1,imax cfq(i,j,k) = 0 if (wuo(i,j,k) .gt. 0.) then cfq(i,j,k) = 1 endif enddo enddo enddo !diagnostic output used = send_data( id_xhlsrc_uwc, xhlsrc, Time, is, js) used = send_data( id_xqtsrc_uwc, xqtsrc, Time, is, js) used = send_data( id_tdt_pevap_uwc, tten_pevap*aday , Time, is, js, 1) used = send_data( id_qdt_pevap_uwc, qvten_pevap*aday, Time, is, js, 1) used = send_data( id_tdt_uwc, tten*aday , Time, is, js, 1) used = send_data( id_qdt_uwc, qvten*aday, Time, is, js, 1) used = send_data( id_cmf_uwc, cmf, Time, is, js, 1) used = send_data( id_cfq_uwc, cfq, Time, is, js, 1) used = send_data( id_wu_uwc, wuo, Time, is, js, 1) used = send_data( id_peo_uwc, peo, Time, is, js, 1) used = send_data( id_fer_uwc, fero, Time, is, js, 1) used = send_data( id_fdr_uwc, fdro, Time, is, js, 1) used = send_data( id_fdrs_uwc, fdrso, Time, is, js, 1) used = send_data( id_cqa_uwc, cldqa, Time, is, js, 1) used = send_data( id_cql_uwc, cldql, Time, is, js, 1) used = send_data( id_cqi_uwc, cldqi, Time, is, js, 1) used = send_data( id_cqn_uwc, cldqn, Time, is, js, 1) used = send_data( id_hlflx_uwc, hlflx, Time, is, js, 1) used = send_data( id_qtflx_uwc, qtflx, Time, is, js, 1) used = send_data( id_hmo_uwc, hmo, Time, is, js, 1) used = send_data( id_hms_uwc, hms, Time, is, js, 1) used = send_data( id_abu_uwc, abu, Time, is, js, 1) used = send_data( id_tdt_rad_uwc,tten_rad*aday,Time, is, js, 1)!miz used = send_data( id_prec_uwc, (rain+snow)*aday, Time, is, js ) used = send_data( id_snow_uwc, (snow)*aday, Time, is, js ) used = send_data( id_cin_uwc, (cino), Time, is, js ) used = send_data( id_cape_uwc, (capeo), Time, is, js ) used = send_data( id_crh_uwc, (crho), Time, is, js ) used = send_data( id_tke_uwc, (tkeo), Time, is, js ) used = send_data( id_cbmf_uwc, (cbmfo), Time, is, js ) used = send_data( id_wrel_uwc, (wrelo), Time, is, js ) used = send_data( id_ufrc_uwc, (ufrco), Time, is, js ) used = send_data( id_plcl_uwc, (plcl*0.01), Time, is, js ) used = send_data( id_plfc_uwc, (plfc*0.01), Time, is, js ) used = send_data( id_plnb_uwc, (plnb*0.01), Time, is, js ) used = send_data( id_zinv_uwc, (zinvo), Time, is, js ) used = send_data( id_cush_uwc, (cush), Time, is, js ) used = send_data( id_dcin_uwc, (dcino), Time, is, js ) used = send_data( id_dcape_uwc,(dcapeo), Time, is, js ) used = send_data( id_dwfn_uwc, (dwfno), Time, is, js ) used = send_data( id_enth_uwc, (denth), Time, is, js ) used = send_data( id_qtmp_uwc, (dqtmp), Time, is, js ) used = send_data( id_dting_uwc,(dting), Time, is, js ) used = send_data( id_ocode_uwc,(ocode), Time, is, js ) used = send_data( id_fdp_uwc, (fdp), Time, is, js ) if ( do_strat ) then used = send_data( id_qldt_uwc, qlten*aday, Time, is, js, 1) used = send_data( id_qidt_uwc, qiten*aday, Time, is, js, 1) used = send_data( id_qadt_uwc, qaten*aday, Time, is, js, 1) used = send_data( id_qndt_uwc, qnten*aday, Time, is, js, 1) used = send_data( id_qldet_uwc, qldet*aday, Time, is, js, 1) used = send_data( id_qidet_uwc, qidet*aday, Time, is, js, 1) used = send_data( id_qadet_uwc, qadet*aday, Time, is, js, 1) used = send_data( id_qtdt_uwc,(qvten+qlten+qiten)*aday,Time, is, js, 1) end if if ( allocated(id_tracerdt_uwc) ) then do n = 1,size(id_tracerdt_uwc) used = send_data( id_tracerdt_uwc(n), trtend(:,:,:,n), Time, is, js, 1) end do end if if ( allocated(id_tracerdt_uwc_col) ) then do n = 1,size(id_tracerdt_uwc_col) if ( id_tracerdt_uwc_col(n) > 0 ) then tempdiag = 0. do k = 1,kmax tempdiag(:,:) = tempdiag(:,:) + trtend(:,:,k,n) * pmass(:,:,k) end do used = send_data( id_tracerdt_uwc_col(n), tempdiag(:,:), Time, is, js) end if end do end if if ( allocated(id_tracerdtwet_uwc) ) then do n = 1,size(id_tracerdtwet_uwc) used = send_data( id_tracerdtwet_uwc(n), trwet(:,:,:,n), Time, is, js, 1) end do end if if ( allocated(id_tracerdtwet_uwc_col) ) then uw_wetdep = 0. do n = 1,size(id_tracerdtwet_uwc_col) if ( id_tracerdtwet_uwc_col(n) > 0 ) then tempdiag = 0. do k = 1,kmax tempdiag(:,:) = tempdiag(:,:) + trwet(:,:,k,n) * pmass(:,:,k) end do used = send_data( id_tracerdtwet_uwc_col(n), tempdiag(:,:), Time, is, js) uw_wetdep(:,:,n) = tempdiag(:,:) end if end do end if !========Option for deep convection======================================= if (do_deep) then used=send_data( id_tdt_pevap_uwd, tten_pevap_d*aday , Time, is, js, 1) used=send_data( id_qdt_pevap_uwd, qvten_pevap_d*aday, Time, is, js, 1) used=send_data( id_tdt_uwd, tten_d*aday , Time, is, js, 1) used=send_data( id_qdt_uwd, qvten_d*aday, Time, is, js, 1) used=send_data( id_qtdt_uwd, qtten_d*aday, Time, is, js, 1) used=send_data( id_cmf_uwd, cmf_d, Time, is, js, 1) used=send_data( id_cbu_uwd, cbu_d, Time, is, js, 1) used=send_data( id_wu_uwd, wuo_d, Time, is, js, 1) used=send_data( id_fer_uwd, fero_d, Time, is, js, 1) used=send_data( id_fdr_uwd, fdro_d, Time, is, js, 1) used=send_data( id_fdrs_uwd, fdrso_d, Time, is, js, 1) used=send_data( id_cqa_uwd, cldqa_d, Time, is, js, 1) used=send_data( id_cql_uwd, cldql_d, Time, is, js, 1) used=send_data( id_cqi_uwd, cldqi_d, Time, is, js, 1) used=send_data( id_cqn_uwd, cldqn_d, Time, is, js, 1) used=send_data( id_hlflx_uwd, hlflx_d, Time, is, js, 1) used=send_data( id_qtflx_uwd, qtflx_d, Time, is, js, 1) used=send_data( id_prec_uwd, (rain_d+snow_d)*aday,Time, is, js ) used=send_data( id_snow_uwd, (snow_d)*aday, Time, is, js ) used=send_data( id_cbmf_uwd, (cbmf_d), Time, is, js ) used=send_data( id_dcapedm_uwd,(dcapedm_d), Time, is, js ) used=send_data( id_dwfn_uwd, (dwfn_d), Time, is, js ) used=send_data( id_enth_uwd, (denth_d), Time, is, js ) used=send_data( id_rkm_uwd, (rkm_d), Time, is, js ) if ( do_strat ) then used=send_data( id_qldt_uwd, qlten_d*aday, Time, is, js, 1) used=send_data( id_qidt_uwd, qiten_d*aday, Time, is, js, 1) used=send_data( id_qadt_uwd, qaten_d*aday, Time, is, js, 1) end if end if !========Option for deep convection======================================= if (.not.apply_tendency) then uten=0.; vten=0.; tten=0.; qvten=0.; cmf=0.; rain=0.; snow=0.; qlten=0.; qiten=0.; qaten=0.; qnten=0.; end if !miz if (do_imposing_rad_cooling) then do j = 1, jmax do i=1, imax tten (i,j,:) = tten (i,j,:) + tten_rad (i,j,:) end do end do end if !miz if (do_gust_cv) then do j = 1, jmax do i=1, imax cbmfo(i,j) = rain(i,j) + snow(i,j) end do end do end if END SUBROUTINE UW_CONV !##################################################################### !##################################################################### subroutine clearit(ac, cc, cp, ct, cp1, ct1) type(adicloud), intent(inout) :: ac type(cclosure), intent(inout) :: cc type(cplume), intent(inout) :: cp,cp1 type(ctend), intent(inout) :: ct,ct1 call ac_clear_k(ac); ac%klcl =0; ac%klfc =0; ac%klnb =0; cc%wrel=0.; cc%ufrc=0.; cc%scaleh=0.; call cp_clear_k(cp); cp%maxcldfrac =1.; call ct_clear_k(ct); call cp_clear_k(cp1); cp1%maxcldfrac=1.; call ct_clear_k(ct1); end subroutine clearit !##################################################################### end MODULE UW_CONV_MOD