!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! GNU General Public License !! !! !! !! This file is part of the Flexible Modeling System (FMS). !! !! !! !! FMS is free software; you can redistribute it and/or modify !! !! it and are expected to follow the terms of the GNU General Public !! !! License as published by the Free Software Foundation. !! !! !! !! FMS is distributed in the hope that it will be useful, !! !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! !! GNU General Public License for more details. !! !! !! !! You should have received a copy of the GNU General Public License !! !! along with FMS; if not, write to: !! !! Free Software Foundation, Inc. !! !! 59 Temple Place, Suite 330 !! !! Boston, MA 02111-1307 USA !! !! or see: !! !! http://www.gnu.org/licenses/gpl.txt !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module moist_processes_mod !----------------------------------------------------------------------- ! ! interface module for moisture processes ! --------------------------------------- ! moist convective adjustment ! relaxed arakawa-schubert ! donner deep convection ! large-scale condensation ! stratiform prognostic cloud scheme ! rel humidity cloud scheme ! diagnostic cloud scheme ! lin cloud microphysics ! betts-miller convective adjustment ! !----------------------------------------------------------------------- ! fms modules use sat_vapor_pres_mod, only: compute_qs, lookup_es use time_manager_mod, only: time_type, get_time use diag_manager_mod, only: register_diag_field, send_data use fms_mod, only: error_mesg, FATAL, NOTE, & file_exist, check_nml_error, & open_namelist_file, close_file, & write_version_number, & mpp_pe, mpp_root_pe, stdlog, & mpp_clock_id, mpp_clock_begin, & mpp_clock_end, CLOCK_MODULE, & MPP_CLOCK_SYNC, read_data, write_data use field_manager_mod, only: MODEL_ATMOS use tracer_manager_mod, only: get_tracer_index,& get_number_tracers, & get_tracer_names, & query_method, & NO_TRACER use constants_mod, only: CP_AIR, GRAV, HLV, HLS, HLF, & RDGAS, RVGAS, TFREEZE, WTMAIR, & SECONDS_PER_DAY, KAPPA ! atmos_param modules use betts_miller_mod, only: betts_miller, betts_miller_init use bm_massflux_mod, only: bm_massflux, bm_massflux_init use bm_omp_mod, only: bm_omp, bm_omp_init use donner_deep_mod, only: donner_deep_init, & donner_deep_time_vary, & donner_deep_endts, & donner_deep, donner_deep_end, & donner_deep_restart use moist_conv_mod, only: moist_conv, moist_conv_init use lscale_cond_mod, only: lscale_cond_init use uw_conv_mod, only: uw_conv_end, uw_conv_init use lin_cld_microphys_mod, only: lin_cld_microphys_init, & lin_cld_microphys_end use ras_mod, only: ras_end, ras_init use dry_adj_mod, only: dry_adj, dry_adj_init use strat_cloud_mod, only: strat_cloud_init, strat_cloud_end, & strat_cloud_restart use rh_clouds_mod, only: rh_clouds_init, rh_clouds_end, & rh_clouds_sum use diag_cloud_mod, only: diag_cloud_init, diag_cloud_end, & diag_cloud_restart use diag_integral_mod, only: diag_integral_field_init, & sum_diag_integral_field use cu_mo_trans_mod, only: cu_mo_trans_init, cu_mo_trans, cu_mo_trans_end use moz_hook_mod, only: moz_hook use rad_utilities_mod, only: aerosol_type use moist_proc_utils_mod, only: capecalcnew, tempavg, column_diag, rh_calc, pmass use moistproc_kernels_mod, only: moistproc_init, moistproc_end, moistproc_mca, & moistproc_ras, moistproc_lscale_cond, & moistproc_strat_cloud, moistproc_cmt, & moistproc_uw_conv, moistproc_scale_uw, & moistproc_scale_donner, & rain_uw, snow_uw, ttnd_uw, qtnd_uw, utnd_uw, & vtnd_uw, qltnd_uw, qitnd_uw, qatnd_uw, & qntnd_uw, qtruw, qlin, qiin, qain, delta_ql, & delta_qi, delta_qa ! atmos_shared modules use atmos_tracer_utilities_mod, only : wet_deposition implicit none private !----------------------------------------------------------------------- !-------------------- public data/interfaces --------------------------- public moist_processes, moist_processes_init, moist_processes_end, & moist_alloc_init, moist_alloc_end, & moist_processes_time_vary, moist_processes_endts, & doing_strat, moist_processes_restart !----------------------------------------------------------------------- !-------------------- private data ------------------------------------- !--------------------- version number ---------------------------------- character(len=128) :: & version = '$Id: moist_processes.F90,v 17.0.2.1.2.1.2.1 2009/10/08 23:35:02 wfc Exp $' character(len=128) :: tagname = '$Name: mom4p1_pubrel_dec2009_nnz $' character(len=5), private :: mod_name = 'moist' logical :: moist_allocated = .false. logical :: module_is_initialized = .false. !-------------------- namelist data (private) -------------------------- !---------------- namelist variable definitions ------------------------ ! ! do_limit_donner = limit Donner deeo tendencies to prevent the ! formation of grid points with negative water vapor, ! liquid or ice. ! ! do_limit_uw = limit UW shallow tendencies to prevent the formation ! of grid points with negative total water specific ! humidities. This situation can occur because both ! shallow and deep convection operate on the same ! soundings without knowledge of what the other is doing ! ! do_unified_convective_closure = use cloud base mass flux calculated ! in uw_conv module as value for donner deep parameter- ! ization; adjust cbmf available for uw shallow appropr- ! iately. only available when uw shallow and donner deep ! are the active convective schemes ! do_mca = switch to turn on/off moist convective adjustment; ! [logical, default: do_mca=true ] ! do_lsc = switch to turn on/off large scale condensation ! [logical, default: do_lsc=true ] ! do_ras = switch to turn on/off relaxed arakawa shubert ! [logical, default: do_ras=false ] ! do_donner_deep = switch to turn on/off donner deep convection scheme ! [logical, default: do_donner_deep=false ] ! do_strat = switch to turn on/off stratiform cloud scheme ! [logical, default: do_strat=false ] ! do_rh_clouds = switch to turn on/off simple relative humidity cloud scheme ! [logical, default: do_rh_clouds=false ] ! do_diag_clouds = switch to turn on/off (Gordon's) diagnostic cloud scheme ! [logical, default: do_diag_clouds=false ] ! do_dryadj = switch to turn on/off dry adjustment scheme ! [logical, default: do_dryadj=false ] ! do_lin_cld_microphys = switch to turn on/off the Lin Cloud Micro-Physics scheme ! [logical, default: do_lin_cld_microphys=false ] ! do_liq_num = switch to turn on/off the prognostic droplet number scheme. ! [logical, default: do_liq_num=false ] ! use_tau = switch to determine whether current time level (tau) ! will be used or else future time level (tau+1). ! if use_tau = true then the input values for t,q, and r ! are used; if use_tau = false then input values ! tm+tdt*dt, etc. are used. ! [logical, default: use_tau=false ] ! ! pdepth = boundary layer depth in pascals for determining mean ! temperature tfreeze (used for snowfall determination) ! tfreeze = mean temperature used for snowfall determination (deg k) ! [real, default: tfreeze=273.16] ! ! do_gust_cv = switch to use convective gustiness (default = false) ! gustmax = maximum convective gustiness (m/s) ! gustconst = precip rate which defines precip rate which begins to ! matter for convective gustiness (kg/m2/sec) ! cmt_mass_flux_source = parameterization(s) being used to supply the ! mass flux profiles seen by the cumulus momentum transport ! module; currently either 'ras', 'donner', 'uw', ! 'donner_and_ras', 'donner_and_uw', 'ras_and_uw', ! 'donner_and_ras_and_uw' or 'all' ! ! do_bm = switch to turn on/off betts-miller scheme ! [logical, default: do_bm=false ] ! do_bmmass = switch to turn on/off betts-miller massflux scheme ! [logical, default: do_bmmass=false ] ! do_bmomp = switch to turn on/off olivier's version of the betts-miller ! scheme (with separated boundary layer) ! [logical, default: do_bmomp=false ] ! do_simple = switch to turn on alternative definition of specific humidity. ! When true, specific humidity = (rdgas/rvgas)*esat/pressure ! ! notes: 1) do_lsc and do_strat cannot both be true ! 2) pdepth and tfreeze are used to determine liquid vs. solid ! precipitation for mca, lsc, and ras schemes, the ! stratiform scheme determines it's own precipitation type. ! 3) if do_strat=true then stratiform cloud tracers: liq_wat, ! ice_wat, cld_amt must be present ! 4) do_donner_deep and do_rh_clouds cannot both be true ! (pending revision of code flow) ! !----------------------------------------------------------------------- ! main convection/large-scale schemes logical :: do_bm=.false. logical :: do_bmmass =.false. logical :: do_bmomp =.false. logical :: do_cmt=.false. logical :: do_diag_clouds=.false. logical :: do_donner_deep=.false. logical :: do_dryadj=.false. logical :: do_lin_cld_microphys=.false. logical :: do_lsc=.true. logical :: do_mca=.true. logical :: do_ras=.false. logical :: do_rh_clouds=.false. logical :: do_strat=.false. logical :: do_uw_conv=.false. ! tracers logical :: do_tracers_in_donner =.false. logical :: do_tracers_in_mca = .false. logical :: do_tracers_in_ras = .false. logical :: do_tracers_in_uw = .false. ! donner specific logical :: do_donner_before_uw = .false. logical :: do_donner_mca=.true. logical :: do_donner_conservation_checks = .false. logical :: do_limit_donner = .false. ! .false. produces previous ! behavior (cjg) logical :: force_donner_moist_conserv = .false. ! cmt specific logical :: cmt_uses_donner = .false. logical :: cmt_uses_ras = .false. logical :: cmt_uses_uw = .false. ! others logical :: doing_diffusive logical :: use_updated_profiles_for_uw = .false. logical :: only_one_conv_scheme_per_column = .false. logical :: limit_conv_cloud_frac = .false. logical :: include_donmca_in_cosp = .true. logical :: use_tau=.false. logical :: do_gust_cv = .false. logical :: do_liq_num = .false. logical :: do_simple =.false. logical :: do_unified_convective_closure = .false. logical :: do_limit_uw = .false. ! .false. produces previous ! behavior (cjg ) logical :: using_fms = .true. character(len=64) :: cmt_mass_flux_source = 'ras' integer :: tau_sg = 0 integer :: k_sg = 2 real :: pdepth = 150.e2 real :: gustmax = 3. ! maximum gustiness wind (m/s) real :: gustconst = 10./SECONDS_PER_DAY ! constant in kg/m2/sec, default = ! 1 cm/day = 10 mm/day namelist /moist_processes_nml/ do_mca, do_lsc, do_ras, do_uw_conv, do_strat, & do_donner_before_uw, use_updated_profiles_for_uw, & only_one_conv_scheme_per_column, do_diag_clouds, & limit_conv_cloud_frac, do_dryadj, pdepth, & include_donmca_in_cosp, & do_unified_convective_closure, tau_sg, k_sg, & do_lin_cld_microphys, use_tau, do_rh_clouds, & cmt_mass_flux_source, do_donner_deep, do_cmt, & do_gust_cv, cmt_mass_flux_source, gustmax, & gustconst, do_liq_num, force_donner_moist_conserv,& do_donner_conservation_checks, do_donner_mca, & do_limit_uw, do_limit_donner, using_fms, & do_bm, do_bmmass, do_bmomp, do_simple !-------------------- clock definitions -------------------------------- integer :: convection_clock, largescale_clock, donner_clock, mca_clock, ras_clock, & donner_mca_clock, bm_clock, cmt_clock, closure_clock, lscalecond_clock, & stratcloud_clock, shallowcu_clock !-------------------- diagnostics fields ------------------------------- integer :: id_tdt_conv, id_qdt_conv, id_prec_conv, id_snow_conv, & id_snow_tot, id_tot_cld_amt, id_conv_freq, & id_tdt_ls , id_qdt_ls , id_prec_ls , id_snow_ls , & id_precip , id_WVP, id_LWP, id_IWP, id_AWP, id_gust_conv, & id_tot_cloud_area, id_tot_liq_amt, id_tot_ice_amt, & id_tot_h2o, id_tot_vapor, & id_lsc_cloud_area, id_lsc_liq_amt, id_lsc_ice_amt, & id_conv_cloud_area, id_conv_liq_amt, id_conv_ice_amt, & id_LWP_all_clouds, id_IWP_all_clouds, id_WP_all_clouds, & id_tdt_dadj, id_rh, id_qs, id_mc, id_mc_donner, id_mc_full, & id_rh_cmip, id_mc_conv_up, & id_conv_cld_base, id_conv_cld_top, & id_tdt_deep_donner, id_qdt_deep_donner, & id_qadt_deep_donner, id_qldt_deep_donner, & id_qidt_deep_donner, & id_tdt_mca_donner, id_qdt_mca_donner, & id_prec_deep_donner, id_prec_mca_donner,& id_tdt_uw, id_qdt_uw, & id_qadt_uw, id_qldt_uw, id_qidt_uw, id_qndt_uw, & id_prec1_deep_donner, & id_snow_deep_donner, id_snow_mca_donner, & id_qadt_ls, id_qldt_ls, id_qndt_ls, id_qidt_ls, & id_qadt_conv, id_qldt_conv, id_qndt_conv, id_qidt_conv, & id_qa_ls_col, id_ql_ls_col, id_qn_ls_col, id_qi_ls_col, & id_qa_conv_col, id_ql_conv_col, id_qn_conv_col, & id_qi_conv_col, & id_bmflag, id_klzbs, id_invtaubmt, id_invtaubmq, & id_massflux, id_entrop_ls, & id_cape, id_cin, id_tref, id_qref, & id_q_conv_col, id_q_ls_col, id_t_conv_col, id_t_ls_col, & id_enth_moist_col, id_wat_moist_col, & id_enth_ls_col, id_wat_ls_col, & id_enth_conv_col, id_wat_conv_col, & id_enth_donner_col, id_wat_donner_col, & id_enth_donner_col2, & id_enth_donner_col3, & id_enth_donner_col4, & id_enth_donner_col5, & id_enth_donner_col6, & id_enth_donner_col7, & id_enth_mca_donner_col, id_wat_mca_donner_col, & id_enth_uw_col, id_wat_uw_col, & id_scale_donner, id_scale_uw, & id_ras_precip, id_ras_freq, id_don_precip, id_don_freq, & id_lsc_precip, id_lsc_freq, id_uw_precip, id_uw_snow, & id_uw_freq, & id_prod_no, id_m_cdet_donner, id_m_cellup, & id_conv_rain3d, id_conv_snow3d, id_lscale_rain3d, id_lscale_snow3d integer :: id_qvout, id_qaout, id_qlout, id_qiout integer :: id_vaporint, id_condensint, id_precipint, id_diffint integer :: id_vertmotion integer :: id_max_enthalpy_imbal_don, id_max_water_imbal_don integer :: id_max_enthalpy_imbal, id_max_water_imbal integer :: id_enthint, id_lprcp, id_lcondensint, id_enthdiffint integer :: id_wetdep_om, id_wetdep_SOA, id_wetdep_bc, & id_wetdep_so4, id_wetdep_so2, id_wetdep_DMS, & id_wetdep_NH4NO3, id_wetdep_salt, id_wetdep_dust integer, dimension(:), allocatable :: id_tracerdt_conv, & id_tracerdt_conv_col, & id_conv_tracer, & id_conv_tracer_col, & id_tracerdt_mcadon, & id_tracerdt_mcadon_col, & id_wetdep, & id_wet_deposition real :: missing_value = -999. !-------------------- individual scheme tracers ------------------------ logical, dimension(:), allocatable :: tracers_in_donner, tracers_in_uw, & tracers_in_mca, tracers_in_ras integer :: num_donner_tracers=0 integer :: num_mca_tracers=0 integer :: num_ras_tracers=0 integer :: num_uw_tracers=0 integer :: num_tracers=0 integer :: nbcphobic =0 integer :: nbcphilic =0 integer :: nomphobic =0 integer :: nomphilic =0 integer :: nsalt1 =0 integer :: nsalt2 =0 integer :: nsalt3 =0 integer :: nsalt4 =0 integer :: nsalt5 =0 integer :: ndust1 =0 integer :: ndust2 =0 integer :: ndust3 =0 integer :: ndust4 =0 integer :: ndust5 =0 integer :: nDMS =0 integer :: nSO2 =0 integer :: nSO4 =0 integer :: nSOA =0 integer :: nNH4NO3 =0 integer :: nNH4 =0 !------------------- other global variables and parameters ------------- real, parameter :: epst=200. integer :: nsphum, nql, nqi, nqa, nqn ! tracer indices for stratiform clouds integer :: nqr, nqs, nqg ! additional tracer indices for Lin Micro-Physics integer :: ktop ! top layer index for Lin Micro-Physics logical :: do_cosp, donner_meso_is_largescale !------------------ allocatable moist processes variables -------------- real, allocatable, dimension(:,:) :: max_enthalpy_imbal, max_water_imbal, & max_enthalpy_imbal_don, max_water_imbal_don real, allocatable, dimension(:,:,:) :: tin, qin, rin, uin, vin, & ttnd, qtnd, rtnd, utnd, vtnd, ttnd_don, qtnd_don, & delta_temp, delta_vapor, delta_q, & donner_humidity_area, donner_humidity_factor real, allocatable, dimension(:,:,:) :: tin_orig, qin_orig, tdt_init, qdt_init real, allocatable, dimension(:,:,:) :: qtnd_wet, & ! specific humidity tendency (kg/kg/s) cloud_wet, & ! cloud liquid+ice (kg/kg) cloud_frac ! cloud area fraction real, allocatable, dimension(:,:,:) :: liquid_precip, frozen_precip real, allocatable, dimension(:,:,:) :: frz_meso, liq_meso, frz_cell real, allocatable, dimension(:,:,:) :: liq_cell, mca_frz, mca_liq real, allocatable, dimension(:,:,:) :: frz_mesoh, liq_mesoh, frz_cellh, & liq_precflx, ice_precflx, & liq_cellh, mca_frzh, mca_liqh,& ice_precflxh, liq_precflxh real, allocatable, dimension(:,:,:) :: ttnd_conv, qtnd_conv real, allocatable, dimension(:,:,:) :: qsat, det0, det_cmt real, allocatable, dimension(:,:,:) :: mc_full, mc_donner, m_cdet_donner, massflux, mc_donner_up real, allocatable, dimension(:,:,:) :: RH, wetdeptnd, q_ref, t_ref real, allocatable, dimension(:,:,:) :: cf, cmf real, allocatable, dimension(:,:,:,:) :: tracer,tracer_orig, rdt_init, & qtr, q_tnd, donner_tracer real, allocatable, dimension(:,:) :: prec_intgl !----------------------------------------------------------------------- contains !####################################################################### ! used to allocate variables used throughout moist_processes subroutine moist_alloc_init (ix, jx, kx, lx) integer, intent(in) :: ix,jx,kx,lx if (moist_allocated) return allocate( tin (ix,jx,kx)) allocate( qin (ix,jx,kx)) allocate( rin (ix,jx,kx)) allocate( uin (ix,jx,kx)) allocate( vin (ix,jx,kx)) allocate( tin_orig (ix,jx,kx)) allocate( qin_orig (ix,jx,kx)) allocate( t_ref (ix,jx,kx)) allocate( q_ref (ix,jx,kx)) allocate( ttnd (ix,jx,kx)) allocate( qtnd (ix,jx,kx)) allocate( rtnd (ix,jx,kx)) allocate( utnd (ix,jx,kx)) allocate( vtnd (ix,jx,kx)) allocate( ttnd_don (ix,jx,kx)) allocate( qtnd_don (ix,jx,kx)) allocate( ttnd_conv (ix,jx,kx)) allocate( qtnd_conv (ix,jx,kx)) allocate( qtnd_wet (ix,jx,kx)) allocate( tdt_init (ix,jx,kx)) allocate( qdt_init (ix,jx,kx)) allocate( cf (ix,jx,kx)) allocate( cmf (ix,jx,kx)) allocate( delta_temp(ix,jx,kx)) allocate( delta_q (ix,jx,kx)) allocate( delta_vapor(ix,jx,kx)) allocate( donner_humidity_area(ix,jx,kx)) allocate( donner_humidity_factor(ix,jx,kx)) allocate( cloud_wet (ix,jx,kx)) allocate( cloud_frac (ix,jx,kx)) allocate( liquid_precip(ix,jx,kx)) allocate( frozen_precip(ix,jx,kx)) allocate( ice_precflx (ix,jx,kx)) allocate( liq_precflx (ix,jx,kx)) allocate( frz_meso (ix,jx,kx)) allocate( liq_meso (ix,jx,kx)) allocate( frz_cell (ix,jx,kx)) allocate( liq_cell (ix,jx,kx)) allocate( mca_frz (ix,jx,kx)) allocate( mca_liq (ix,jx,kx)) allocate( frz_mesoh (ix,jx,kx+1)) allocate( liq_mesoh (ix,jx,kx+1)) allocate( frz_cellh (ix,jx,kx+1)) allocate( liq_cellh (ix,jx,kx+1)) allocate( mca_liqh (ix,jx,kx+1)) allocate( mca_frzh (ix,jx,kx+1)) allocate( ice_precflxh(ix,jx,kx+1)) allocate( liq_precflxh(ix,jx,kx+1)) allocate( qsat (ix,jx,kx)) allocate( det0 (ix,jx,kx)) allocate( det_cmt (ix,jx,kx)) allocate( mc_full (ix,jx,kx)) allocate( mc_donner (ix,jx,kx)) allocate( mc_donner_up (ix,jx,kx)) allocate( m_cdet_donner(ix,jx,kx)) allocate( massflux (ix,jx,kx)) allocate( RH (ix,jx,kx)) ! pmass defined in moist_processes_utils allocate( pmass (ix,jx,kx)) allocate( wetdeptnd (ix,jx,kx)) allocate(tracer (ix,jx,kx,lx)) allocate(tracer_orig(ix,jx,kx,lx)) allocate(q_tnd (ix,jx,kx,lx)) allocate(rdt_init (ix,jx,kx,lx)) allocate(qtr (ix,jx,kx,num_donner_tracers)) allocate(donner_tracer(ix,jx,kx,num_donner_tracers)) moist_allocated = .true. end subroutine moist_alloc_init !####################################################################### ! used to deallocate variables used throughout moist_processes subroutine moist_alloc_end if (moist_allocated .eqv. .false. ) return deallocate( tin ) deallocate( qin ) deallocate( rin ) deallocate( uin ) deallocate( vin ) deallocate( tin_orig ) deallocate( qin_orig ) deallocate( t_ref ) deallocate( q_ref ) deallocate( ttnd ) deallocate( qtnd ) deallocate( rtnd ) deallocate( utnd ) deallocate( vtnd ) deallocate( ttnd_don ) deallocate( qtnd_don ) deallocate( ttnd_conv ) deallocate( qtnd_conv ) deallocate( qtnd_wet ) deallocate( tdt_init ) deallocate( qdt_init ) deallocate( cf ) deallocate( cmf ) deallocate( delta_temp) deallocate( delta_q ) deallocate( delta_vapor ) deallocate( donner_humidity_area) deallocate( donner_humidity_factor) deallocate( cloud_wet ) deallocate( cloud_frac ) deallocate( liquid_precip) deallocate( frozen_precip) deallocate( ice_precflx) deallocate( liq_precflx) deallocate( frz_meso ) deallocate( liq_meso ) deallocate( frz_cell ) deallocate( liq_cell ) deallocate( mca_frz ) deallocate( mca_liq ) deallocate( frz_mesoh ) deallocate( liq_mesoh ) deallocate( frz_cellh ) deallocate( liq_cellh ) deallocate( mca_frzh ) deallocate( mca_liqh ) deallocate( ice_precflxh) deallocate( liq_precflxh) deallocate( qsat ) deallocate( det0 ) deallocate( det_cmt ) deallocate( mc_full ) deallocate( mc_donner ) deallocate( mc_donner_up ) deallocate( m_cdet_donner) deallocate( massflux ) deallocate( RH ) deallocate( pmass ) deallocate( wetdeptnd ) deallocate(tracer ) deallocate(tracer_orig) deallocate(q_tnd ) deallocate(rdt_init ) deallocate(qtr ) deallocate(donner_tracer) moist_allocated = .false. end subroutine moist_alloc_end !####################################################################### subroutine moist_processes (is, ie, js, je, Time, dt, land, & phalf, pfull, zhalf, zfull, omega, diff_t, & radturbten, cush, cbmf, & pblht, ustar, bstar, qstar, & t, q, r, u, v, tm, qm, rm, um, vm, & tdt, qdt, rdt, udt, vdt, diff_cu_mo, & convect, lprec, fprec, fl_lsrain, & fl_lssnow, fl_ccrain, fl_ccsnow, gust_cv, & area, lat, lsc_cloud_area, lsc_liquid, & lsc_ice, lsc_droplet_number, & Aerosol, mask, kbot, & shallow_cloud_area, shallow_liquid, & shallow_ice, shallow_droplet_number, & cell_cld_frac, cell_liq_amt, cell_liq_size, & cell_ice_amt, cell_ice_size, & cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, & meso_droplet_number, nsum_out, & hydrostatic, phys_hydrostatic) !----------------------------------------------------------------------- ! ! in: is,ie starting and ending i indices for window ! ! js,je starting and ending j indices for window ! ! Time time used for diagnostics [time_type] ! ! dt time step (from t(n-1) to t(n+1) if leapfrog) ! in seconds [real] ! ! land fraction of surface covered by land ! [real, dimension(nlon,nlat)] ! ! phalf pressure at half levels in pascals ! [real, dimension(nlon,nlat,nlev+1)] ! ! pfull pressure at full levels in pascals ! [real, dimension(nlon,nlat,nlev)] ! ! omega omega (vertical velocity) at full levels ! in pascals per second ! [real, dimension(nlon,nlat,nlev)] ! ! diff_t vertical diffusion coefficient for temperature ! and tracer (m*m/sec) on half levels ! [real, dimension(nlon,nlat,nlev)] ! ! t, q temperature (t) [deg k] and specific humidity ! of water vapor (q) [kg/kg] at full model levels, ! at the current time step if leapfrog scheme ! [real, dimension(nlon,nlat,nlev)] ! ! r tracer fields at full model levels, ! at the current time step if leapfrog ! [real, dimension(nlon,nlat,nlev,ntrace)] ! ! u, v, zonal and meridional wind [m/s] at full model levels, ! at the current time step if leapfrog scheme ! [real, dimension(nlon,nlat,nlev)] ! ! tm, qm temperature (t) [deg k] and specific humidity ! of water vapor (q) [kg/kg] at full model levels, ! at the previous time step if leapfrog scheme ! [real, dimension(nlon,nlat,nlev)] ! ! rm tracer fields at full model levels, ! at the previous time step if leapfrog ! [real, dimension(nlon,nlat,nlev,ntrace)] ! ! um, vm zonal and meridional wind [m/s] at full model levels, ! at the previous time step if leapfrog ! [real, dimension(nlon,nlat,nlev)] ! ! area grid box area (in m2) ! [real, dimension(nlon,nlat)] ! ! lat latitude in radians ! [real, dimension(nlon,nlat)] ! ! inout: tdt, qdt temperature (tdt) [deg k/sec] and specific ! humidity of water vapor (qdt) tendency [1/sec] ! [real, dimension(nlon,nlat,nlev)] ! ! rdt tracer tendencies ! [real, dimension(nlon,nlat,nlev,ntrace)] ! ! udt, vdt zonal and meridional wind tendencies [m/s/s] ! ! out: convect is moist convection occurring in this grid box? ! [logical, dimension(nlon,nlat)] ! ! lprec liquid precipitiaton rate (rain) in kg/m2/s ! [real, dimension(nlon,nlat)] ! ! fprec frozen precipitation rate (snow) in kg/m2/s ! [real, dimension(nlon,nlat)] ! ! gust_cv gustiness from convection in m/s ! [real, dimension(nlon,nlat)] ! ! optional ! ----------------- ! ! in: mask mask (1. or 0.) for grid boxes above or below ! the ground [real, dimension(nlon,nlat,nlev)] ! ! kbot index of the lowest model level ! [integer, dimension(nlon,nlat)] ! ! !----------------------------------------------------------------------- integer, intent(in) :: is,ie,js,je type(time_type), intent(in) :: Time real, intent(in) :: dt real, intent(in) , dimension(:,:) :: land, pblht, ustar, bstar, qstar real, intent(inout), dimension(:,:) :: cush, cbmf real, intent(in) , dimension(:,:,:) :: phalf, pfull, zhalf, zfull, omega, & diff_t, t, q, u, v, tm, qm, um, vm real, dimension(:,:,:), intent(in) :: radturbten real, intent(in) , dimension(:,:,:,:) :: r, rm real, intent(inout),dimension(:,:,:) :: tdt, qdt, udt, vdt real, intent(inout),dimension(:,:,:,:):: rdt logical, intent(out), dimension(:,:) :: convect real, intent(out), dimension(:,:) :: lprec, fprec, gust_cv real, intent(out), dimension(:,:,:) :: fl_lsrain, fl_lssnow, & fl_ccrain, fl_ccsnow real, intent(out), dimension(:,:,:) :: diff_cu_mo real, intent(in) , dimension(:,:) :: area real, intent(in) , dimension(:,:) :: lat real, intent(out) , dimension(:,:,:) :: lsc_cloud_area, lsc_liquid,& lsc_ice, lsc_droplet_number type(aerosol_type),intent(in), optional :: Aerosol real, intent(in) , dimension(:,:,:), optional :: mask integer, intent(in), dimension(:,:), optional :: kbot logical, intent(in), optional :: hydrostatic, phys_hydrostatic integer, intent(inout), dimension(:,:), optional :: nsum_out real, intent(inout), dimension(:,:,:), optional :: & shallow_cloud_area, shallow_liquid, & shallow_ice, shallow_droplet_number, & cell_cld_frac, cell_liq_amt, cell_liq_size, & cell_ice_amt, cell_ice_size, & cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, & meso_droplet_number !----------------------------------------------------------------------- integer :: secs, days integer :: n, nn, i, j, k, ix, jx, kx, nt, tr integer :: m, mm logical :: used, avgbl real :: sumneg real :: dtinv real, dimension(size(t,1),size(t,2)) :: cape, cin real, dimension(size(t,1),size(t,2)) :: precip, total_precip, lheat_precip, & precip_returned, precip_adjustment, & vert_motion real, dimension(size(t,1),size(t,2)) :: rain, snow, & rain_don, snow_don, & rain_ras, snow_ras, & rain_donmca, snow_donmca real, dimension(size(t,1),size(t,2)) :: bmflag, klzbs, invtaubmt, invtaubmq real, dimension(size(t,1),size(t,2)) :: scale real, dimension(size(t,1),size(t,2)) :: freq_count real, dimension(size(t,1),size(t,2)) :: enthint, lcondensint, enthdiffint, & vaporint, condensint, precipint, diffint real, dimension(size(t,1),size(t,2),size(phalf,3)) :: rain3d, snow3d real, dimension(size(t,1),size(t,2),size(phalf,3)) :: snowclr3d real, dimension(size(t,1),size(t,2),size(t,3)+1) :: mc, m_cellup, mc_cmt ! sfc_sh_flux sensible heat flux across the surface ! [ watts / m**2 ] ! sfc_vapor_flux water vapor flux across the surface ! [ kg(h2o) / (m**2 sec) ] ! tr_flux tracer fux across the surface ! [ kg(tracer) / (m**2 sec) ] real, dimension(size(t,1),size(t,2)) :: sfc_sh_flux, sfc_vapor_flux real, dimension(size(t,1),size(t,2),num_donner_tracers) :: tr_flux real, dimension(size(t,1),size(t,2),num_donner_tracers) :: & donner_wetdep real, dimension(size(t,1),size(t,2),num_uw_tracers) :: & uw_wetdep real, dimension(size(t,1),size(t,2),size(rdt,4) ) :: total_wetdep real, dimension(size(t,1),size(t,2),size(rdt,4) ) :: & total_wetdep_uw real, dimension(size(t,1),size(t,2),size(rdt,4) ) :: & total_wetdep_donner real, dimension(size(t,1),size(t,2),size(rdt,4) ) :: ls_wetdep real, dimension(size(t,1),size(t,2),size(t,3) ) :: total_conv_cloud,& conv_cld_frac, tot_conv_liq, tot_conv_ice !chemistry start real, parameter :: boltz = 1.38044e-16 integer, dimension(size(rdt,1),size(rdt,2)) :: cldtop, cldbot real, dimension(size(rdt,1),size(rdt,2),size(rdt,3)) :: prod_no real, dimension(size(rdt,1),size(rdt,2),size(rdt,3),size(rdt,4)) :: wet_data !chemistry end real, dimension(size(t,1),size(t,2)) :: adjust_frac real, dimension(size(t,1),size(t,2),size(t,3)) :: ttnd_adjustment real, dimension(size(t,1),size(t,2),size(t,3)) :: available_cf_for_uw logical, dimension(size(t,1),size(t,2)) :: conv_calc_completed logical, dimension(size(t,1),size(t,2)) :: coldT !temporary variables real :: temp logical, dimension(size(t,1),size(t,2)) :: ltemp real, dimension(size(t,1),size(t,2)) :: temp_2d real, dimension(size(t,1),size(t,2)) :: cldarea, tca2 real, dimension(size(t,1),size(t,2),size(t,3)) :: total_cloud_area real, dimension(size(t,1),size(t,2),size(t,3)) :: temp_3d1, temp_3d2, temp_3d3 !-------- input array size and position in global storage -------------- ix=size(t,1); jx=size(t,2); kx=size(t,3); nt=size(rdt,4) !--------------------------------------------------------------------- ! verify that the module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized) then call error_mesg ('moist_processes_mod', & 'moist_processes_init has not been called.', FATAL) endif conv_calc_completed = .false. available_cf_for_uw = 1.0 !-------------------------------------------------------------------- ! define the inverse of the time step. !-------------------------------------------------------------------- dtinv = 1.0/dt !-------------------------------------------------------------------- ! initialize the arrays which will be used in this subroutine. !-------------------------------------------------------------------- rain_don = 0.0 snow_don = 0.0 rain_donmca = 0.0 snow_donmca = 0.0 lprec = 0.0 fprec = 0.0 fl_lsrain(:,:,:) = 0. fl_lssnow(:,:,:) = 0. fl_ccrain(:,:,:) = 0. fl_ccsnow(:,:,:) = 0. convect = .false. gust_cv = 0.0 precip = 0.0 rain3d = 0.0 snow3d = 0.0 !--------------------------------------------------------------------- ! initialize local arrays which will hold sums. !--------------------------------------------------------------------- rdt_init(is:ie,js:je,:,:) = rdt tdt_init(is:ie,js:je,:) = tdt qdt_init(is:ie,js:je,:) = qdt ttnd_conv(is:ie,js:je,:) = 0. qtnd_conv(is:ie,js:je,:) = 0. qtnd(is:ie,js:je,:) = 0. q_tnd(is:ie,js:je,:,:) = 0. !--------------------------------------------------------------------- ! define input fields to be used, either the tau time level fields, ! or the tau - 1 time level values updated with the time tendencies ! thus far calculated on the current step. control is through nml ! variable use_tau. !--------------------------------------------------------------------- if (use_tau) then tin(is:ie,js:je,:) = t qin(is:ie,js:je,:) = q uin(is:ie,js:je,:) = u vin(is:ie,js:je,:) = v do tr=1,size(r,4) tracer(is:ie,js:je,:,tr) = r(:,:,:,tr) end do else tin(is:ie,js:je,:) = tm + tdt*dt qin(is:ie,js:je,:) = qm + qdt*dt uin(is:ie,js:je,:) = um + udt*dt vin(is:ie,js:je,:) = vm + vdt*dt do tr=1,size(rdt,4) tracer(is:ie,js:je,:,tr) = rm(:,:,:,tr) + rdt(:,:,:,tr)*dt end do do tr=size(rdt,4) +1, size(r,4) tracer(is:ie,js:je,:,tr) = r(:,:,:,tr) end do endif !-------------------------------------------------------------------- ! if using eta vertical coordinate, define the appropriate values ! for any points located below the ground. values of 0.0 are given ! to u, v and q, and a temperature value of EPST (=200. K) is given ! to sub-surface points. !-------------------------------------------------------------------- if (present(mask) .and. present(kbot)) then tin(is:ie,js:je,:) = mask*tin(is:ie,js:je,:) + (1.0 - mask)*EPST qin(is:ie,js:je,:) = mask*qin(is:ie,js:je,:) uin(is:ie,js:je,:) = mask*uin(is:ie,js:je,:) vin(is:ie,js:je,:) = mask*vin(is:ie,js:je,:) do tr=1,size(r,4) tracer(is:ie,js:je,:,tr) = mask(:,:,:)*tracer(is:ie,js:je,:,tr) end do endif !---------------------------------------------------------------------- ! compute the mass in each model layer. !---------------------------------------------------------------------- do k=1,kx pmass(is:ie,js:je,k) = (phalf(:,:,k+1) - phalf(:,:,k))/GRAV end do !---------------------------------------------------------------------- ! output any requested convectively-transported tracer fields ! and / or their column sums before convective transport. !---------------------------------------------------------------------- do n=1,num_tracers used = send_data (id_conv_tracer(n), tracer(is:ie,js:je,:,n), Time, & is, js, 1, rmask=mask) if (id_conv_tracer_col(n) > 0) & call column_diag(id_conv_tracer_col(n), is, js, Time, & tracer(is:ie,js:je,:,n), 1.0) end do !---------------------------------------------------------------------- ! compute the mean temperature in the lower atmosphere (the lowest ! pdepth Pa), to be used to determine whether rain or snow reaches ! the surface. define a logical variable coldT indicating whether ! snow or rain falls in the column. ! ???? SHOULD TIN BE USED RATHER THAN t ?? !---------------------------------------------------------------------- call tempavg (pdepth, phalf, t, snow, mask) coldT = .false. where (snow(:,:) <= TFREEZE) coldT(:,:) = .true. endwhere !--------------------------------------------------------------------- ! begin the clock timing the dry and moist convection parameter- ! izations. !--------------------------------------------------------------------- call mpp_clock_begin (convection_clock) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! DRY CONVECTION PARAMETERIZATION ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !--------------------------------------------------------------------- ! if dry adjustment is desired call subroutine dry_adj to obtain ! the temperature tendencie swhich must be applied to adjust each ! column to a non-superadiabatic lapse rate. !--------------------------------------------------------------------- if (do_dryadj) then call dry_adj (tin(is:ie,js:je,:), pfull, phalf, delta_temp(is:ie,js:je,:), mask) !------------------------------------------------------------------- ! add the temperature change due to dry adjustment to the current ! temperature. convert the temperature change to a heating rate and ! add that to the temperature temndency array accumulating the ten- ! dencies due to all physics processes. !------------------------------------------------------------------- tin(is:ie,js:je,:) = tin(is:ie,js:je,:) + delta_temp(is:ie,js:je,:) ttnd(is:ie,js:je,:) = delta_temp(is:ie,js:je,:)*dtinv tdt = tdt + ttnd(is:ie,js:je,:) !--------------------------------------------------------------------- ! output the temperature tendency from dry adjustment, if desired. !--------------------------------------------------------------------- used = send_data (id_tdt_dadj, ttnd(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) !--------------------------------------------------------------------- ! add the temperature time tendency from dry adjustment to the array ! accumulating the total temperature time tendency from convection. !--------------------------------------------------------------------- ttnd_conv(is:ie,js:je,:) = ttnd_conv(is:ie,js:je,:) + ttnd(is:ie,js:je,:) endif !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! MOIST CONVECTION PARAMETERIZATIONS ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! 0. UW SHALLOW CONVECTION PARAMETERIZATION ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ cmf(is:ie,js:je,:) = 0. tracer_orig(is:ie,js:je,:,:) = tracer(is:ie,js:je,:,:) if (.not. do_donner_before_uw) then call mpp_clock_begin (shallowcu_clock) if (do_uw_conv) then !--------------------------------------------------------------------- ! be sure all optional arguments associated with the uw_conv param- ! eterization are present. !--------------------------------------------------------------------- if & (present (shallow_cloud_area) .and. & present (shallow_liquid) .and. & present (shallow_ice) .and. & present ( shallow_droplet_number) ) then else call error_mesg ('moist_processes_mod', 'moist_processes: & ¬ all 4 optional arguments needed for uw_conv & &output are present', FATAL) endif call moistproc_uw_conv(Time, is, ie, js, je, dt, tin(is:ie,js:je,:), qin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), & pfull, phalf, zfull, zhalf, omega, pblht, & ustar, bstar, qstar, land, coldT, Aerosol, & cush, cbmf, cmf(is:ie,js:je,:), conv_calc_completed, & available_cf_for_uw, tdt, qdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), lprec, fprec, precip, & liq_precflx(is:ie,js:je,:), & ice_precflx(is:ie,js:je,:), & do_strat, do_limit_uw, do_liq_num, num_tracers, & tracers_in_uw, num_uw_tracers, shallow_cloud_area,& shallow_liquid, shallow_ice, shallow_droplet_number, uw_wetdep) endif !(do_uw_conv) call mpp_clock_end (shallowcu_clock) else tin_orig(is:ie,js:je,:) = tin(is:ie,js:je,:) qin_orig(is:ie,js:je,:) = qin(is:ie,js:je,:) ! tracer_orig = tracer endif ! (.not do_donner_before_uw) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! A. DONNER DEEP CONVECTION PARAMETERIZATION ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !--------------------------------------------------------------------- ! if donner_deep convection is activated, execute the following code. !--------------------------------------------------------------------- if (do_donner_deep) then call mpp_clock_begin (donner_clock) !--------------------------------------------------------------------- ! be sure all optional arguments associated with the donner param- ! eterization are present. !--------------------------------------------------------------------- if & (present (cell_cld_frac) .and. & present (cell_liq_amt) .and. present ( cell_liq_size) .and. & present (cell_ice_amt) .and. present ( cell_ice_size) .and. & present (cell_droplet_number) .and. & present (meso_cld_frac) .and. & present (meso_liq_amt) .and. present ( meso_liq_size) .and. & present (meso_ice_amt) .and. present ( meso_ice_size) .and. & present (meso_droplet_number) .and. & present (nsum_out) ) then else call error_mesg ('moist_processes_mod', 'moist_processes: & ¬ all 13 optional arguments needed for donner_deep & &output are present', FATAL) endif !-------------------------------------------------------------------- ! if strat_cloud_mod is activated, define the cloud liquid and ! cloud ice specific humidities and cloud area associated with ! strat_cloud_mod, so that they may be input to donner_deep_mod. ! if strat_cloud_mod is not activated, define these arrays to be ! zero. !-------------------------------------------------------------------- if (do_strat) then qlin(is:ie,js:je,:) = tracer(is:ie,js:je,:,nql) qiin(is:ie,js:je,:) = tracer(is:ie,js:je,:,nqi) qain(is:ie,js:je,:) = tracer(is:ie,js:je,:,nqa) endif !-------------------------------------------------------------------- ! convert vapor specific humidity to vapor mixing ratio so it may ! be input to donner_deep_mod. !-------------------------------------------------------------------- rin(is:ie,js:je,:) = qin(is:ie,js:je,:)/(1.0 - qin(is:ie,js:je,:)) !--------------------------------------------------------------------- ! if any tracers are to be transported by donner convection, ! check each active tracer to find those to be transported and fill ! the donner_tracers array with these fields. !--------------------------------------------------------------------- donner_tracer(is:ie,js:je,:,:) = 0.0 nn = 1 do n=1,num_tracers if (tracers_in_donner(n)) then donner_tracer(is:ie,js:je,:,nn) = tracer(is:ie,js:je,:,n) nn = nn + 1 endif end do !--------------------------------------------------------------------- ! NOTE 1: sfc_sh_flux, sfc_vapor_flux, tr_flux are the surface fluxes ! that will have been obtained from the flux exchange module ! and passed on to moist_processes and then to donner_deep. ! FOR NOW, these values are defined herein, and given ! values of 0.0 !--------------------------------------------------------------------- ! sfc_sh_flux = INPUT_SFC_SH_FLUX_FROM_COUPLER ! sfc_vapor_flux = INPUT_SFC_VAPOR_FLUX_FROM_COUPLER sfc_sh_flux = 0.0 sfc_vapor_flux = 0.0 tr_flux = 0.0 nn = 1 do n=1,num_tracers if (tracers_in_donner(n)) then ! tr_flux(:,:,nn) = INPUT_SFC_FLUX_FROM_COUPLER(:,:,n) tr_flux(:,:,nn) = 0.0 nn = nn + 1 endif end do temp_2d=pblht temp_2d=min(max(temp_2d, 0.0),5000.); temp_2d=ustar**3.+0.6*ustar*bstar*temp_2d where (temp_2d .gt. 0.) temp_2d = temp_2d**(2./3.) end where temp_2d = MAX (1.e-6, temp_2d) !--------------------------------------------------------------------- ! call donner_deep to compute the effects of deep convection on the ! temperature, vapor mixing ratio, tracers, cloud liquid, cloud ice ! cloud area and precipitation fields. !--------------------------------------------------------------------- call get_time (Time, secs, days) if (do_strat) then call donner_deep (is, ie, js, je, dt, tin(is:ie,js:je,:), rin(is:ie,js:je,:), pfull, & phalf, zfull, zhalf, omega, pblht, temp_2d, & qstar, cush, coldT, land, sfc_sh_flux, &!miz sfc_vapor_flux, tr_flux, & donner_tracer(is:ie,js:je,:,:), secs, days, cbmf, & cell_cld_frac, cell_liq_amt, cell_liq_size, & cell_ice_amt, cell_ice_size, & cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, & meso_droplet_number, nsum_out, & precip_returned, delta_temp(is:ie,js:je,:), delta_vapor(is:ie,js:je,:), & m_cdet_donner(is:ie,js:je,:), m_cellup, mc_donner(is:ie,js:je,:), & mc_donner_up(is:ie,js:je,:), & donner_humidity_area(is:ie,js:je,:), donner_humidity_factor(is:ie,js:je,:),& qtr(is:ie,js:je,:,:), & donner_wetdep, & lheat_precip, vert_motion, & total_precip, liquid_precip(is:ie,js:je,:), frozen_precip(is:ie,js:je,:), & frz_meso(is:ie,js:je,:), liq_meso(is:ie,js:je,:), & frz_cell(is:ie,js:je,:), liq_cell(is:ie,js:je,:), & qlin(is:ie,js:je,:), qiin(is:ie,js:je,:), qain(is:ie,js:je,:), delta_ql(is:ie,js:je,:), &!optional delta_qi(is:ie,js:je,:), delta_qa(is:ie,js:je,:)) !optional else call donner_deep (is, ie, js, je, dt, tin(is:ie,js:je,:), rin(is:ie,js:je,:), pfull, & phalf, zfull, zhalf, omega, pblht, temp_2d, & qstar, cush, coldT, land, sfc_sh_flux, &!miz sfc_vapor_flux, tr_flux, & donner_tracer(is:ie,js:je,:,:), secs, days, cbmf, & cell_cld_frac, cell_liq_amt, cell_liq_size, & cell_ice_amt, cell_ice_size, & cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, & meso_droplet_number, nsum_out, & precip_returned, delta_temp(is:ie,js:je,:), delta_vapor(is:ie,js:je,:), & m_cdet_donner(is:ie,js:je,:), m_cellup, mc_donner(is:ie,js:je,:), & mc_donner_up(is:ie,js:je,:), & donner_humidity_area(is:ie,js:je,:), donner_humidity_factor(is:ie,js:je,:),& qtr(is:ie,js:je,:,:), donner_wetdep, & lheat_precip, vert_motion, & total_precip, liquid_precip(is:ie,js:je,:), & frozen_precip(is:ie,js:je,:), & frz_meso(is:ie,js:je,:), liq_meso(is:ie,js:je,:), & frz_cell(is:ie,js:je,:), liq_cell(is:Ie,js:je,:)) endif !--------------------------------------------------------------------- ! update the current timestep tracer changes with the contributions ! just obtained from donner transport. !--------------------------------------------------------------------- nn = 1 do n=1, num_tracers if (tracers_in_donner(n)) then rdt(:,:,:,n) = rdt(:,:,:,n) + qtr(is:ie,js:je,:,nn) nn = nn + 1 endif end do if (do_donner_conservation_checks) then vaporint = 0. lcondensint = 0. condensint = 0. diffint = 0. enthint = 0. enthdiffint = 0. do k=1,kx vaporint(:,:) = vaporint(:,:) + pmass (is:ie,js:je,k)*delta_vapor(is:ie,js:je,k) enthint(:,:) = enthint(:,:) + CP_AIR*pmass(is:ie,js:je,k)*delta_temp(is:ie,js:je,k) condensint(:,:) = condensint(:,:) + pmass(is:ie,js:je,k) * & (delta_ql(is:ie,js:je,k) + delta_qi(is:ie,js:je,k)) lcondensint(:,:) = lcondensint(:,:) + pmass(is:ie,js:je,k) * & (HLV*delta_ql(is:ie,js:je,k) + HLS*delta_qi(is:ie,js:je,k)) end do precipint = total_precip/seconds_per_day diffint = (vaporint + condensint)*dtinv + precipint enthdiffint = (enthint - lcondensint)*dtinv - & lheat_precip/seconds_per_day - vert_motion/seconds_per_day do j=1,size(enthdiffint,2) do i=1,size(enthdiffint,1) max_enthalpy_imbal_don(i,j) = max( abs(enthdiffint(i,j)), & max_enthalpy_imbal_don(i,j) ) max_water_imbal_don(i,j) = max( abs(diffint(i,j)), & max_water_imbal_don(i,j) ) end do end do used = send_data(id_max_enthalpy_imbal_don, max_enthalpy_imbal_don, Time, is, js) used = send_data(id_max_water_imbal_don, max_water_imbal_don, Time, is, js) used = send_data(id_vaporint, vaporint*dtinv, Time, is, js) used = send_data(id_condensint, condensint*dtinv, Time, is, js) used = send_data(id_vertmotion, vert_motion/seconds_per_day, Time, is, js) used = send_data(id_precipint, precipint, Time, is, js) used = send_data(id_diffint, diffint, Time, is, js) used = send_data(id_enthint, enthint*dtinv, Time, is, js) used = send_data(id_lcondensint, lcondensint*dtinv, Time, is, js) used = send_data(id_lprcp, lheat_precip/seconds_per_day, Time, is, js) used = send_data(id_enthdiffint, enthdiffint, Time, is, js) endif !-------------------------------------------------------------------- ! obtain updated vapor specific humidity (qnew) resulting from deep ! convection. define the vapor specific humidity change due to deep ! convection (qtnd). !-------------------------------------------------------------------- do k=1,kx do j=js,je do i=is,ie if (delta_vapor(i,j,k) /= 0.0) then !was qnew... now temp temp = (rin(i,j,k) + delta_vapor(i,j,k))/ & (1.0 + (rin(i,j,k) + delta_vapor(i,j,k))) delta_q(i,j,k) = temp - qin(i,j,k) else delta_q(i,j,k) = 0. endif enddo enddo end do !--------------------------------------------------------------------- ! scale Donner tendencies to prevent the formation of negative ! total water specific humidities !--------------------------------------------------------------------- if (do_strat .and. do_limit_donner) then call moistproc_scale_donner(is,ie,js,je,qin(is:ie,js:je,:), delta_temp(is:ie,js:je,:), delta_q(is:ie,js:je,:), precip_returned, & total_precip, lheat_precip, liquid_precip(is:ie,js:je,:), & frozen_precip(is:ie,js:je,:), num_tracers, tracers_in_donner,& qtr(is:ie,js:je,:,:), scale) used = send_data (id_scale_donner, scale, Time, is, js ) else scale = 1.0 used = send_data (id_scale_donner, scale, Time, is, js ) end if ! (do_strat and do_limit_donner) !--------------------------------------------------------------------- ! recalculate the precip using the delta specific humidity tenden- ! cies. define precip_adjustment as the change in precipitation ! resulting from the recalculation. !--------------------------------------------------------------------- if (force_donner_moist_conserv) then !--------------------------------------------------------------------- ! calculate the precipitation needed to balance the change in water ! content in the column. !--------------------------------------------------------------------- temp_2d = 0. do k=1,kx temp_2d (:,:) = temp_2d (:,:) + (-delta_q(is:ie,js:je,k) - & delta_ql(is:ie,js:je,k) -delta_qi(is:ie,js:je,k))* & pmass(is:ie,js:je,k) end do precip_adjustment = (temp_2d - precip_returned) do j=1,jx do i=1,ix if (ABS(precip_adjustment(i,j)) < 1.0e-10) then precip_adjustment (i,j) = 0.0 endif end do end do !---------------------------------------------------------------------- ! now adjust the temperature change to balance the precip adjustment ! and so conserve enthalpy in the column. !--------------------------------------------------------------------- do j=1,jx do i=1,ix if (precip_returned(i,j) > 0.0) then adjust_frac(i,j) = precip_adjustment(i,j)/precip_returned(i,j) else adjust_frac(i,j) = 0. endif end do end do do k=1,kx ttnd_adjustment(:,:,k) = & ((HLV*liquid_precip(is:ie,js:je,k)*adjust_frac(:,:) + & HLS*frozen_precip(is:ie,js:je,k)*adjust_frac(:,:)) & *dt/seconds_per_day)/CP_AIR liquid_precip(is:ie,js:je,k) = liquid_precip(is:ie,js:je,k) * (1.0+adjust_frac(:,:)) frozen_precip(is:ie,js:je,k) = frozen_precip(is:ie,js:je,k) * (1.0+adjust_frac(:,:)) end do else ! (force_donner_moist_conserv) precip_adjustment(:,:) = 0.0 adjust_frac (:,:) = 0.0 ttnd_adjustment(:,:,:) = 0. endif ! (force_donner_moist_conserv) do k=1,kx rain_don(:,:) = rain_don(:,:) + liquid_precip(is:ie,js:je,k)* pmass(is:ie,js:je,k)/seconds_per_day snow_don(:,:) = snow_don(:,:) + frozen_precip(is:ie,js:je,k)* pmass(is:ie,js:je,k)/seconds_per_day end do !---------------------------------------------------------------------- ! modify each of the 3d precip fluxes returned from donner_deep, as ! needed. !---------------------------------------------------------------------- if (do_cosp) then do k=1, size(t,3) do j=js,je do i=is,ie frz_meso(i,j,k) = frz_meso(i,j,k)*pmass(i,j,k)* & scale(i-is+1,j-js+1)*(1.0+adjust_frac(i-is+1,j-js+1))/ & SECONDS_PER_DAY liq_meso(i,j,k) = liq_meso(i,j,k)*pmass(i,j,k)* & scale(i-is+1,j-js+1)*(1.0+adjust_frac(i-is+1,j-js+1))/ & SECONDS_PER_DAY frz_cell(i,j,k) = frz_cell(i,j,k)*pmass(i,j,k)* & scale(i-is+1,j-js+1)*(1.0+adjust_frac(i-is+1,j-js+1))/ & SECONDS_PER_DAY liq_cell(i,j,k) = liq_cell(i,j,k)*pmass(i,j,k)* & scale(i-is+1,j-js+1)*(1.0+adjust_frac(i-is+1,j-js+1))/ & SECONDS_PER_DAY end do end do end do endif if (only_one_conv_scheme_per_column) then conv_calc_completed = (rain_don + snow_don) > 0.0 endif !--------------------------------------------------------------------- ! convert the changes in temperature, vapor specific humidity and ! precipitation resulting from deep convection to time tendencies ! of these quantities. !--------------------------------------------------------------------- ttnd_don(is:ie,js:je,:) = delta_temp(is:ie,js:je,:)*dtinv ttnd_don(is:ie,js:je,:) = ttnd_don(is:ie,js:je,:) + ttnd_adjustment*dtinv qtnd_don(is:ie,js:je,:) = delta_q(is:ie,js:je,:)*dtinv !-------------------------------------------------------------------- ! save the tendencies of temperature and specific humidity resulting ! from the deep convection component of the donner parameterization. !-------------------------------------------------------------------- ttnd_conv(is:ie,js:je,:) = ttnd_conv(is:ie,js:je,:) + ttnd_don(is:ie,js:je,:) qtnd_conv(is:ie,js:je,:) = qtnd_conv(is:ie,js:je,:) + qtnd_don(is:ie,js:je,:) !-------------------------------------------------------------------- ! add the contributions to the temperature and vapor specific ! humidity tendencies from donner_deep mod to the arrays accumulating ! the total tendencies due to all physics processes. !-------------------------------------------------------------------- tdt = tdt + ttnd_don(is:ie,js:je,:) qdt = qdt + qtnd_don(is:ie,js:je,:) !-------------------------------------------------------------------- ! add the liquid (rain) and frozen (snow) precipitation generated by ! deep convection on this step to the arrays accumulating precip- ! itation from all sources (lprec, fprec). !-------------------------------------------------------------------- lprec = lprec + rain_don fprec = fprec + snow_don !-------------------------------------------------------------------- ! output the time tendencies of temperature, vapor specific humid- ! ity, precipitation and mass flux due to deep convection. !-------------------------------------------------------------------- used = send_data (id_tdt_deep_donner, ttnd_don(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_qdt_deep_donner, qtnd_don(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_qadt_deep_donner, delta_qa(is:ie,js:je,:)*dtinv, Time, is, js, 1, rmask=mask ) used = send_data (id_qldt_deep_donner, delta_ql(is:ie,js:je,:)*dtinv, Time, is, js, 1, rmask=mask ) used = send_data (id_qidt_deep_donner, delta_qi(is:ie,js:je,:)*dtinv, Time, is, js, 1, rmask=mask ) used = send_data (id_mc_donner, mc_donner(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_m_cdet_donner, m_cdet_donner(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_m_cellup, m_cellup, Time, is, js, 1, rmask=mask ) used = send_data (id_snow_deep_donner, snow_don, Time, is, js) used = send_data (id_prec_deep_donner, rain_don + snow_don, Time, is, js ) used = send_data (id_prec1_deep_donner, precip_adjustment, & Time, is, js, mask = precip_returned > 0.0) if (do_donner_conservation_checks) then used = send_data (id_enth_donner_col2, -hlv*rain_don, Time, is, js) used = send_data (id_enth_donner_col3, -hls*snow_don, Time, is, js) if (id_enth_donner_col4 > 0) call column_diag(id_enth_donner_col4, is, js, Time, & ttnd_don(is:ie,js:je,:), CP_AIR) if (id_enth_donner_col5 > 0) call column_diag(id_enth_donner_col5, is, js, Time, & delta_ql(is:ie,js:je,:), -HLV*dtinv, delta_qi(is:ie,js:je,:), -HLS*dtinv) if (id_enth_donner_col6 > 0) call column_diag(id_enth_donner_col6, is, js, Time, & ttnd_adjustment, CP_AIR) used = send_data (id_enth_donner_col7, adjust_frac, Time, is, js) temp_2d = 0. do k=1,kx temp_2d(:,:) = temp_2d(:,:) & + (-HLV*liquid_precip(is:ie,js:je,k)/seconds_per_day - & hls*frozen_precip(is:ie,js:je,k)/seconds_per_day + & CP_AIR*ttnd_don(is:ie,js:je,k) & - (HLV*delta_ql(is:ie,js:je,k)*dtinv + HLS*delta_qi(is:ie,js:je,k)*dtinv) & )*pmass(is:ie,js:je,k) end do used = send_data (id_enth_donner_col, temp_2d, Time, is, js) if (id_wat_donner_col > 0) then temp_2d = rain_don + snow_don call column_diag(id_wat_donner_col, is, js, Time, qtnd_don(is:ie,js:je,:), 1.0, & delta_ql(is:ie,js:je,:), dtinv, delta_qi(is:ie,js:je,:), dtinv, temp_2d) endif endif ! (donner_conservation_checks) call mpp_clock_end (donner_clock) if (do_donner_mca) then call mpp_clock_begin (donner_mca_clock) !-------------------------------------------------------------------- ! call subroutine moist_conv to handle any shallow convection ! present in the grid. in this call do_strat is always set to .false. ! so that no convective detrainment (and corresponding change in ! large-scale cloud amount and area) from moist convective adjustment ! is allowed, consistent with this call being constrained to handle ! shallow convection. !-------------------------------------------------------------------- tin(is:ie,js:je,:) = tin(is:ie,js:je,:)+delta_temp(is:ie,js:je,:) qin(is:ie,js:je,:) = qin(is:ie,js:je,:)+delta_q(is:ie,js:je,:) call moist_conv (tin(is:ie,js:je,:), qin(is:ie,js:je,:), pfull, phalf, coldT, ttnd_don(is:ie,js:je,:), qtnd_don(is:ie,js:je,:), & rain_donmca, snow_donmca, dtinv, Time, is, js, & donner_tracer(is:ie,js:je,:,:), qtr(is:ie,js:je,:,:), Lbot=kbot, mask=mask) if (include_donmca_in_cosp) then do j=js,je do i=is,ie if (coldT(i-is+1,j-js+1)) then do k=1,kx mca_frz(i,j,k) = -1.0*qtnd_don(i,j,k)*pmass(i,j,k) mca_liq(i,j,k) = 0. end do else do k=1,kx mca_frz(i,j,k) = 0. mca_liq(i,j,k) = -1.0*qtnd_don(i,j,k)*pmass(i,j,k) end do endif end do end do else mca_frz(is:ie,js:je,:) = 0. mca_liq(is:ie,js:je,:) = 0. endif !--------------------------------------------------------------------- ! update the current tracer tendencies with the contributions ! just obtained from moist convective adjustment. currently there ! is no tracer transport by this process. !--------------------------------------------------------------------- nn = 1 do n=1, num_tracers if (tracers_in_donner(n)) then rdt(:,:,:,n) = rdt(:,:,:,n) + qtr(is:ie,js:je,:,nn) nn = nn + 1 endif end do !-------------------------------------------------------------------- ! define the heating, moistening and precipitation rates as the sum ! of the contributions from the deep convection pass and the moist ! convective adjustment pass of the donner parameterization. if ! ras_mod is also activated, store these values in temporary arrays ! until the contributions from ras_mod is calculated. !-------------------------------------------------------------------- ttnd_conv(is:ie,js:je,:) = ttnd_conv(is:ie,js:je,:) + ttnd_don(is:ie,js:je,:) qtnd_conv(is:ie,js:je,:) = qtnd_conv(is:ie,js:je,:) + qtnd_don(is:ie,js:je,:) !-------------------------------------------------------------------- ! add the contributions to the temperature and vapor specific ! humidity tendencies from the moist convective adjustment pass of ! donner_deep_mod to the arrays accumulating the total tendencies ! due to all physics processes. !-------------------------------------------------------------------- tdt = tdt + ttnd_don(is:ie,js:je,:) qdt = qdt + qtnd_don(is:ie,js:je,:) !-------------------------------------------------------------------- ! add the liquid (rain) and frozen (snow) precipitation generated by ! the moist convective adjustment pass of the donner parameterization ! on this step to the arrays accumulating precipitation from all ! sources (lprec, fprec). !-------------------------------------------------------------------- lprec = lprec + rain_donmca fprec = fprec + snow_donmca !-------------------------------------------------------------------- ! output the time tendencies of temperature, vapor specific humid- ! ity, precipitation and snow due to the moist convective ! adjustment pass of the donner parameterization. !-------------------------------------------------------------------- used = send_data (id_tdt_mca_donner, ttnd_don(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qdt_mca_donner, qtnd_don(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_prec_mca_donner, rain_donmca+snow_donmca, Time, is, js) used = send_data (id_snow_mca_donner, snow_donmca, Time, is, js) if (id_enth_mca_donner_col > 0) then temp_2d = -HLV*rain_donmca -HLS*snow_donmca call column_diag(id_enth_mca_donner_col, is, js, Time, ttnd_don(is:ie,js:je,:), CP_AIR, temp_2d) endif if (id_wat_mca_donner_col > 0) then temp_2d = rain_donmca + snow_donmca call column_diag(id_wat_mca_donner_col, is, js, Time, qtnd_don(is:ie,js:je,:), 1.0, temp_2d) endif !-------------------------------------------------------------------- !------- diagnostics for tracers from convection ------- ! allow any tracer to be activated here (allows control cases) !-------------------------------------------------------------------- do n=1,num_tracers used = send_data ( id_conv_tracer(n), tracer(is:ie,js:je,:,n), Time, is, js, 1, & rmask=mask ) !------- diagnostics for tracers column integral tendency ------ if ( id_conv_tracer_col(n) > 0 ) & call column_diag(id_conv_tracer_col(n), is, js, Time, tracer(is:ie,js:je,:,n), 1.0) enddo !-------------------------------------------------------------------- ! output the time tendencies of tracer and of column tracer ! due to the moist convective adjustment pass of the donner ! parameterization. currently moist convective adjustment does not ! affect the tracer fields, so these fields are always 0.0. !-------------------------------------------------------------------- do n = 1, num_donner_tracers if ( id_tracerdt_mcadon(n) > 0 ) & used = send_data(id_tracerdt_mcadon(n), qtr(is:ie,js:je,:,n), Time, is, js, 1, rmask=mask ) if (id_tracerdt_mcadon_col(n) > 0 ) & call column_diag(id_tracerdt_mcadon_col(n), is, js, Time, qtr(is:ie,js:je,:,n), 1.0) enddo call mpp_clock_end (donner_mca_clock) endif !(do_donner_mca) !--------------------------------------------------------------------- ! if donner_deep_mod is not active, define input fields normally ! produced by donner_deep_mod and needed by strat_cloud_mod ! appropriately. !--------------------------------------------------------------------- else ! (do_donner_deep) mc_donner(is:ie,js:je,:) = 0.0 mc_donner_up(is:ie,js:je,:) = 0.0 m_cdet_donner(is:ie,js:je,:) = 0.0 m_cellup = 0.0 donner_humidity_area(is:ie,js:je,:) = 0. donner_humidity_factor(is:ie,js:je,:) = 0. endif ! (do_donner_deep) ! ADD TENDENCIES HERE, IN SAME AORDER AS ORIGINAL: if (do_donner_deep) then if (limit_conv_cloud_frac) then ltemp = ANY(donner_humidity_area(is:ie,js:je,:) >= 0.999, dim = 3) where (ltemp(:,:)) conv_calc_completed(:,:) = .true. available_cf_for_uw = MAX(0.999 - donner_humidity_area(is:ie,js:je,:), 0.0) endif if (do_strat) then tracer(is:ie,js:je,:,nql) = qlin(is:ie,js:je,:) + delta_ql(is:ie,js:je,:) tracer(is:ie,js:je,:,nqi) = qiin(is:ie,js:je,:) + delta_qi(is:ie,js:je,:) tracer(is:ie,js:je,:,nqa) = qain(is:ie,js:je,:) + delta_qa(is:ie,js:je,:) rdt(:,:,:,nql) = rdt(:,:,:,nql) + delta_ql(is:ie,js:je,:)*dtinv rdt(:,:,:,nqi) = rdt(:,:,:,nqi) + delta_qi(is:ie,js:je,:)*dtinv rdt(:,:,:,nqa) = rdt(:,:,:,nqa) + delta_qa(is:ie,js:je,:)*dtinv endif !--------------------------------------------------------------------- ! update the values of temperature and vapor specific humidity to ! include the effects of deep convection. !--------------------------------------------------------------------- if (.not. do_donner_mca) then tin(is:ie,js:je,:) = tin(is:ie,js:je,:) + delta_temp(is:ie,js:je,:) qin(is:ie,js:je,:) = qin(is:ie,js:je,:) + delta_q(is:ie,js:je,:) endif endif !(do_donner_deep) if (do_donner_before_uw) then if (do_uw_conv) then call mpp_clock_begin (shallowcu_clock) !--------------------------------------------------------------------- ! be sure all optional arguments associated with the uw_conv param- ! eterization are present. !--------------------------------------------------------------------- if & (present (shallow_cloud_area) .and. & present (shallow_liquid) .and. & present (shallow_ice) .and. & present ( shallow_droplet_number) ) then else call error_mesg ('moist_processes_mod', 'moist_processes: & ¬ all 4 optional arguments needed for uw_conv & &output are present', FATAL) endif if (use_updated_profiles_for_uw) then !--------------------------------------------------------------------- ! update tracer fields with tendencies due to donner convection and ! wet deposition by donner deep precipitation. !--------------------------------------------------------------------- do n=1,size(rdt,4) if (n /= nsphum) then if (.not. do_strat .or. ( n /= nql .and. n /= nqi .and. & n /= nqa .and. n /= nqn) ) then tracer(is:ie,js:je,:,n) = tracer_orig(is:ie,js:je,:,n) + & (rdt(:,:,:,n) - rdt_init(is:ie,js:je,:,n)) *dt endif endif end do call moistproc_uw_conv(Time, is, ie, js, je, dt, tin(is:ie,js:je,:), qin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), & pfull, phalf, zfull, zhalf, omega, pblht, & ustar, bstar, qstar, land, coldT, Aerosol, & cush, cbmf, cmf(is:ie,js:je,:), conv_calc_completed, & available_cf_for_uw, tdt, qdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), lprec, fprec, precip, & liq_precflx(is:ie,js:je,:), & ice_precflx(is:ie,js:je,:), & do_strat, do_limit_uw, do_liq_num, num_tracers, & tracers_in_uw, num_uw_tracers, shallow_cloud_area,& shallow_liquid, shallow_ice, shallow_droplet_number, uw_wetdep) else ! (.not. use_updated_profiles_for_uw) call moistproc_uw_conv(Time, is, ie, js, je, dt, tin_orig(is:ie,js:je,:), qin_orig(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer_orig(is:ie,js:je,:,:), & pfull, phalf, zfull, zhalf, omega, pblht, & ustar, bstar, qstar, land, coldT, Aerosol, & cush, cbmf, cmf(is:ie,js:je,:), conv_calc_completed, & available_cf_for_uw, tdt, qdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), lprec, fprec, precip, & liq_precflx(is:ie,js:je,:), & ice_precflx(is:ie,js:je,:), & do_strat, do_limit_uw, do_liq_num, num_tracers, & tracers_in_uw, num_uw_tracers, shallow_cloud_area,& shallow_liquid, shallow_ice, shallow_droplet_number, uw_wetdep) endif ! (use_updated_profiles_for_uw) call mpp_clock_end (shallowcu_clock) endif !(do_uw_conv) endif !(do_donner_before_uw) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! B. MOIST CONVECTIVE ADJUSTMENT ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ if (do_mca) then call mpp_clock_begin (mca_clock) call moistproc_mca(Time, is, js, tin(is:ie,js:je,:), qin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), pfull, phalf, coldT, dtinv, & tdt, qdt, rdt, q_tnd(is:ie,js:je,:,:), ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), & lprec, fprec, do_strat, num_tracers, tracers_in_mca, & num_mca_tracers, kbot, mask) call mpp_clock_end (mca_clock) endif ! (do_mca) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! X. BETTS-MILLER CONVECTION SCHEME ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ if ( any((/do_bm,do_bmmass,do_bmomp/)) ) then call mpp_clock_begin (bm_clock) if (do_bm) then ! betts-miller cumulus param scheme call betts_miller (dt,tin(is:ie,js:je,:),qin(is:ie,js:je,:),pfull,phalf,coldT,rain,snow,ttnd(is:ie,js:je,:),qtnd(is:ie,js:je,:), & q_ref(is:ie,js:je,:),bmflag,klzbs,cape,cin,t_ref(is:ie,js:je,:),invtaubmt, & invtaubmq, mask=mask) endif if (do_bmmass) then ! betts-miller-style massflux cumulus param scheme call bm_massflux (dt,tin(is:ie,js:je,:),qin(is:ie,js:je,:),pfull,phalf,coldT,rain,snow,ttnd(is:ie,js:je,:),qtnd(is:ie,js:je,:), & q_ref(is:ie,js:je,:),bmflag,klzbs,t_ref(is:ie,js:je,:),massflux(is:ie,js:je,:), mask=mask) endif if (do_bmomp) then ! olivier's betts-miller cumulus param scheme call bm_omp (dt,tin(is:ie,js:je,:),qin(is:ie,js:je,:),pfull,phalf,coldT,rain,snow,ttnd(is:ie,js:je,:),qtnd(is:ie,js:je,:), & q_ref(is:ie,js:je,:),bmflag,klzbs,t_ref(is:ie,js:je,:), mask=mask) endif !------- (update input values and) compute tendency ----- tin(is:ie,js:je,:)=tin(is:ie,js:je,:)+ttnd(is:ie,js:je,:) qin(is:ie,js:je,:)=qin(is:ie,js:je,:)+qtnd(is:ie,js:je,:) ttnd(is:ie,js:je,:)=ttnd(is:ie,js:je,:)*dtinv qtnd(is:ie,js:je,:)=qtnd(is:ie,js:je,:)*dtinv rain=rain*dtinv snow=snow*dtinv !-------- add on tendency ---------- tdt=tdt+ttnd(is:ie,js:je,:) qdt=qdt+qtnd(is:ie,js:je,:) !------- save total precip and snow --------- lprec=lprec+rain fprec=fprec+snow precip=precip+rain+snow !------- compute rh clouds if desired ------ if (do_rh_clouds) then !calculate relative humidity call rh_calc(pfull,tin(is:ie,js:je,:),qin(is:ie,js:je,:),RH(is:ie,js:je,:),do_simple,mask) !pass RH to rh_clouds_sum call rh_clouds_sum (is, js, RH(is:ie,js:je,:)) ! XXX RH is not relative humidity when do_simple=.true. end if ! betts-miller diags used = send_data (id_tref, t_ref(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_qref, q_ref(is:ie,js:je,:), Time, is, js, 1, rmask=mask ) used = send_data (id_bmflag, bmflag, Time, is, js) used = send_data (id_klzbs, klzbs, Time, is, js) used = send_data (id_invtaubmt, invtaubmt, Time, is, js) used = send_data (id_invtaubmq, invtaubmq, Time, is, js) used = send_data (id_massflux, massflux(is:ie,js:je,:), Time, is, js, 1, rmask=mask) call mpp_clock_end (bm_clock) endif ! if ( any((/do_bm,do_bmmass,do_bmomp/)) ) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! C. RELAXED ARAKAWA-SCHUBERT PARAMETERIZATION ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !----------------------------------------------------------------------- ! execute relaxed arakawa/schubert cumulus parameterization scheme, ! if desired. !----------------------------------------------------------------------- if (do_ras) then call mpp_clock_begin (ras_clock) call moistproc_ras(Time, is, js, dt, coldT, tin(is:ie,js:je,:), qin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:),& pfull, phalf, zhalf, tdt, qdt, udt, vdt, rdt, & q_tnd(is:ie,js:je,:,:), ttnd(is:ie,js:je,:), qtnd(is:ie,js:je,:), ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), mc, det0(is:ie,js:je,:), & lprec, fprec, rain_ras, snow_ras, rain3d, snow3d, & Aerosol, do_strat, do_liq_num, num_tracers, & tracers_in_ras, num_ras_tracers, kbot, mask) call mpp_clock_end (ras_clock) else !--------------------------------------------------------------------- ! if ras_mod is not activated, set the ras mass flux field to be 0.0. !--------------------------------------------------------------------- mc = 0.0 det0(is:ie,js:je,:) = 0.0 rain_ras = 0.0 snow_ras = 0.0 endif ! (do_ras) !--------------------------------------------------------------------- ! call subroutine cu_mo_trans if diffusive cumulus momentum ! transport is desired. !--------------------------------------------------------------------- if (do_cmt) then call mpp_clock_begin (cmt_clock) diff_cu_mo(:,:,:) = 0.0 ! if doing nonlocal cmt, call cu_mo_trans for each convective scheme ! separately if (.not. doing_diffusive) then if (cmt_uses_ras) then ! mc_cmt = mc ! det_cmt = det0 call moistproc_cmt ( Time, is, js, tin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), pfull, phalf, & zfull, zhalf, pmass(is:ie,js:je,:), tdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), dt, mc, det0(is:ie,js:je,:), diff_cu_mo, & num_tracers) endif !(cmt_uses_ras) ! if (cmt_uses_donner) then ! mc_cmt = m_cellup ! det_cmt = m_cdet_donner call moistproc_cmt ( Time, is, js, tin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), pfull, phalf, & zfull, zhalf, pmass(is:ie,js:je,:), tdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), dt, m_cellup, M_cdet_donner(is:ie,js:je,:), diff_cu_mo,& num_tracers) endif ! if (cmt_uses_uw) then mc_cmt(:,:,1) = 0. mc_cmt(:,:,kx+1) = 0. do k=2,kx mc_cmt(:,:,k) = cmf(is:ie,js:je,k-1) end do ! CURRENTLY no detrained mass flux provided from uw_conv; should only ! use with 'diffusive' cmt scheme, not the non-local. (attempt to ! use non-local will cause FATAL in _init routine.) det_cmt(is:ie,js:je,:) = 0.0 call moistproc_cmt ( Time, is, js, tin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), pfull, phalf, & zfull, zhalf, pmass(is:ie,js:je,:), tdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), dt, mc_cmt, det_cmt(is:ie,js:je,:), diff_cu_mo, & num_tracers) endif else ! (we are doing_diffusive) ! if using diffusive cmt, call cu_mo_trans once with combined mass ! fluxes from all desired convective schemes. mc_cmt = 0. det_cmt(is:ie,js:je,:) = 0. if (cmt_uses_ras) then mc_cmt = mc_cmt + mc endif if (cmt_uses_donner) then mc_cmt = mc_cmt + m_cellup endif if (cmt_uses_uw) then do k=2,kx mc_cmt(:,:,k) = mc_cmt(:,:,k) + cmf(is:ie,js:je,k-1) end do endif call moistproc_cmt ( Time, is, js, tin(is:ie,js:je,:), uin(is:ie,js:je,:), vin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), pfull, phalf, & zfull, zhalf, pmass(is:ie,js:je,:), tdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), dt, mc_cmt, det_cmt(is:ie,js:je,:), diff_cu_mo, & num_tracers) endif ! (.not. doing_diffusive) call mpp_clock_end (cmt_clock) else !(do_cmt) diff_cu_mo(:,:,:) = 0.0 endif ! (do_cmt) !--------------------------------------------------------------------- ! calculate the tracer tendency due to wet deposition (wetdeptnd) ! caused by the convectively generated precipitation (rain, snow) for ! any tracers for which wet deposition has been activated. add this ! tendency to the tracer tendency due to all physics (rdt). save it ! also in an array which will be combined with any wet deposition ! resulting from large-scale precip producing the total wet deposition ! for the tracer (wet_data). !--------------------------------------------------------------------- wet_data = 0.0 qtnd_wet(is:ie,js:je,:) = qtnd(is:ie,js:je,:) if (do_strat) then qtnd_wet(is:ie,js:je,:) = qtnd_wet(is:ie,js:je,:) + q_tnd(is:ie,js:je,:,nql) + q_tnd(is:ie,js:je,:,nqi) cloud_wet(is:ie,js:je,:) = 1.e-3 else cloud_wet(is:ie,js:je,:) = 1.e-3 end if cloud_frac(is:ie,js:je,:) = 0.1 do n=1,size(rdt,4) if ( n /= nsphum ) then if ( .not. do_strat .or. (n /= nql .and. n /= nqi .and. n /= nqa .and. n /= nqn) ) then wetdeptnd(is:ie,js:je,:) = 0.0 call wet_deposition( n, t, pfull, phalf, zfull, zhalf, rain_ras, snow_ras, & qtnd_wet(is:ie,js:je,:), cloud_wet(is:ie,js:je,:), cloud_frac(is:ie,js:je,:), & rain3d, snow3d, tracer(is:ie,js:je,:,n), wetdeptnd(is:ie,js:je,:), & Time, 'convect', is, js, dt ) rdt (:,:,:,n) = rdt(:,:,:,n) - wetdeptnd(is:ie,js:je,:) wet_data(:,:,:,n) = wetdeptnd(is:ie,js:je,:) endif endif end do mc_full(is:ie,js:je,:)=0.; do k=2,kx mc_full(is:ie,js:je,k) = 0.5*(mc(:,:,k) + mc(:,:,k+1)) + & 0.5*(cmf(is:ie,js:je,k)+cmf(is:ie,js:je,k-1)) + & mc_donner(is:ie,js:je,k) end do if ( get_tracer_index(MODEL_ATMOS,'no') .ne. NO_TRACER & .or. id_conv_freq > 0 & .or. id_conv_cld_base > 0 & .or. id_conv_cld_top > 0 ) then cldbot = 0 cldtop = 0 do j = 1,jx do i = 1,ix do k = 1,kx if (mc_full(i+is-1,j+js-1,k) /= 0 ) then cldtop(i,j) = k exit endif enddo do k = size(r,3),1,-1 if (mc_full(i+is-1,j+js-1,k) /= 0 ) then cldbot(i,j) = k exit endif enddo enddo enddo end if if ( id_conv_cld_base > 0 ) then temp_2d = missing_value do j = 1,jx do i = 1,ix if ( cldbot(i,j) > 0 ) temp_2d(i,j) = pfull(i,j,cldbot(i,j)) end do end do used = send_data(id_conv_cld_base, temp_2d, Time, is_in=is, & js_in=js, mask = cldbot > 0) end if if ( id_conv_cld_top > 0 ) then temp_2d = missing_value do j = 1,jx do i = 1,ix if ( cldtop(i,j) > 0 ) temp_2d(i,j) = pfull(i,j,cldtop(i,j)) end do end do used = send_data(id_conv_cld_top, temp_2d, Time, is_in=is, & js_in=js, mask = cldtop > 0) end if !----------------------------------------------------------------------- ! lightning NOx parameterization !----------------------------------------------------------------------- if ( get_tracer_index(MODEL_ATMOS,'no') .ne. NO_TRACER ) then cldbot = 0 cldtop = 0 do i = 1,ix do j = 1,jx do k = 1,kx if (mc_full(i+is-1,j+js-1,k) /= 0 ) then cldtop(i,j) = k exit endif enddo do k = size(r,3),1,-1 if (mc_full(i+is-1,j+js-1,k) /= 0 ) then cldbot(i,j) = k exit endif enddo enddo enddo call moz_hook(cldtop, cldbot, land, zfull, zhalf, t, prod_no, area, lat, & Time, is, js) rdt(:,:,:,get_tracer_index(MODEL_ATMOS,'no')) = & rdt(:,:,:,get_tracer_index(MODEL_ATMOS,'no')) + & prod_no* ((boltz * t) / (10. * pfull)) ! conc_air used = send_data(id_prod_no,prod_no, Time, is_in=is, js_in=js) endif !----------------------------------------------------------------------- ! define the total precipitation rate (precip). !----------------------------------------------------------------------- precip = lprec + fprec !----------------------------------------------------------------------- ! calculate convective gustiness, if desired. !----------------------------------------------------------------------- if (do_gust_cv) then where((precip) > 0.0) gust_cv = gustmax*sqrt( precip/(gustconst + precip) ) end where end if !--------------------------------------------------------------------- ! save a diagnostic indicating whether or not convection has occurred ! within the column. !--------------------------------------------------------------------- where (precip > 0.) convect = .true. !--------------------------------------------------------------------- ! apply changes resulting from uw_conv !--------------------------------------------------------------------- if (do_uw_conv) then if (do_limit_uw) then call moistproc_scale_uw(is,ie,js,je,dt, qin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), tdt, qdt, udt, vdt, rdt, & ttnd_conv(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), lprec, fprec, precip,& do_strat, do_liq_num, num_tracers, & tracers_in_uw, scale) used = send_data (id_scale_uw, scale, Time, is, js ) else !(do_limit_uw) scale = 1.0 used = send_data (id_scale_uw, scale, Time, is, js ) endif !(do_limit_uw) ! update input fields with changes from uw_conv tin(is:ie,js:je,:) = tin(is:ie,js:je,:) + ttnd_uw(is:ie,js:je,:)*dt qin(is:ie,js:je,:) = qin(is:ie,js:je,:) + qtnd_uw(is:ie,js:je,:)*dt uin(is:ie,js:je,:) = uin(is:ie,js:je,:) + utnd_uw(is:ie,js:je,:)*dt vin(is:ie,js:je,:) = vin(is:ie,js:je,:) + vtnd_uw(is:ie,js:je,:)*dt tracer(is:ie,js:je,:,nql) = tracer(is:ie,js:je,:,nql) + qltnd_uw(is:ie,js:je,:)*dt tracer(is:ie,js:je,:,nqi) = tracer(is:ie,js:je,:,nqi) + qitnd_uw(is:ie,js:je,:)*dt tracer(is:ie,js:je,:,nqa) = tracer(is:ie,js:je,:,nqa) + qatnd_uw(is:ie,js:je,:)*dt if (do_liq_num) then tracer(is:ie,js:je,:,nqn) = tracer(is:ie,js:je,:,nqn) + qntnd_uw(is:ie,js:je,:)*dt endif endif !(uw_conv) !--------------------------------------------------------------------- ! update tracer fields with tendencies due to convection and wet ! deposition by convective precipitation. !--------------------------------------------------------------------- do n=1,size(rdt,4) if (n /= nsphum) then if (.not. do_strat .or. ( n /= nql .and. n /= nqi .and. & n /= nqa .and. n /= nqn) ) then ! tracer(:,:,:,n) = tracer(:,:,:,n) + & tracer(is:ie,js:je,:,n) = tracer_orig(is:ie,js:je,:,n) + & (rdt(:,:,:,n) - rdt_init(is:ie,js:je,:,n)) *dt endif endif end do !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! CONVECTION DIAGNOSTICS ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ used = send_data (id_ras_precip, rain_ras+snow_ras, Time, is, js) used = send_data (id_don_precip, rain_don+snow_don+rain_donmca+snow_donmca, & Time, is, js) ! uw_conv diags used = send_data (id_uw_precip, rain_uw(is:ie,js:je) + snow_uw(is:ie,js:je), Time, is, js) used = send_data (id_uw_snow, snow_uw, Time, is, js) used = send_data (id_tdt_uw, ttnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qdt_uw, qtnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qadt_uw, qatnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qldt_uw, qltnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qidt_uw, qitnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_qndt_uw, qntnd_uw(is:ie,js:je,:), Time, is, js, 1, rmask=mask) if (id_ras_freq > 0) then ltemp = rain_ras > 0. .or. snow_ras > 0.0 temp_2d = 0. where (ltemp) temp_2d = 1. end where used = send_data (id_ras_freq, temp_2d,Time, is, js) endif if (id_don_freq > 0) then ltemp = rain_don > 0. .or. snow_don > 0.0 .or. & rain_donmca > 0. .or. snow_donmca > 0.0 temp_2d = 0. where (ltemp) temp_2d = 1. end where used = send_data (id_don_freq, temp_2d, Time, is, js) endif if (id_uw_freq > 0) then ltemp = rain_uw(is:ie,js:je) > 0. .or. snow_uw(is:ie,js:je) > 0.0 temp_2d = 0. where (ltemp) temp_2d = 1. end where used = send_data (id_uw_freq, temp_2d, Time, is, js) endif if (id_enth_uw_col > 0) then temp_2d = -HLV*rain_uw(is:ie,js:je) -HLS*snow_uw(is:ie,js:je) call column_diag(id_enth_uw_col, is, js, Time, ttnd_uw(is:ie,js:je,:), CP_AIR, qltnd_uw(is:ie,js:je,:), -HLV, qitnd_uw(is:ie,js:je,:), -HLS, temp_2d) endif if (id_wat_uw_col > 0) then temp_2d = rain_uw(is:ie,js:je) + snow_uw(is:ie,js:je) call column_diag(id_wat_uw_col, is, js, Time, qtnd_uw(is:ie,js:je,:), 1.0, qltnd_uw(is:ie,js:je,:), 1.0, qitnd_uw(is:ie,js:je,:), 1.0, temp_2d) endif !--------------------------------------------------------------------- ! temperature change due to dry and moist convection: !--------------------------------------------------------------------- used = send_data (id_tdt_conv, ttnd_conv(is:ie,js:je,:), Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! vapor specific humidity change due to convection: !--------------------------------------------------------------------- used = send_data (id_qdt_conv, qtnd_conv(is:ie,js:je,:), Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! total precipitation due to convection: !--------------------------------------------------------------------- used = send_data (id_prec_conv, precip, Time, is, js) !--------------------------------------------------------------------- ! frozen precipitation (snow) due to convection: !--------------------------------------------------------------------- used = send_data (id_snow_conv, fprec, Time, is, js) !--------------------------------------------------------------------- ! convective frequency !--------------------------------------------------------------------- if (id_conv_freq > 0) then ltemp = precip > 0. .or. cldtop > 0 where (ltemp) freq_count = 1. elsewhere freq_count = 0. end where used = send_data (id_conv_freq, freq_count, Time, is, js ) endif !--------------------------------------------------------------------- !------- diagnostics for 3D precip_conv ------- !--------------------------------------------------------------------- used = send_data ( id_conv_rain3d, rain3d, Time, is, js, 1 ) !--------------------------------------------------------------------- !------- diagnostics for 3D snow_conv ------- !--------------------------------------------------------------------- used = send_data ( id_conv_snow3d, snow3d, Time, is, js, 1 ) !--------------------------------------------------------------------- ! surface wind gustiness due to convection: !--------------------------------------------------------------------- used = send_data (id_gust_conv, gust_cv, Time, is, js) !--------------------------------------------------------------------- ! water vapor path tendency due to convection: !--------------------------------------------------------------------- if (id_q_conv_col > 0) call column_diag(id_q_conv_col, is, js, Time, qtnd_conv(is:ie,js:je,:), 1.0) !--------------------------------------------------------------------- ! dry static energy tendency due to dry and moist convection: !--------------------------------------------------------------------- if (id_t_conv_col > 0) call column_diag(id_t_conv_col, is, js, Time, ttnd_conv(is:ie,js:je,:), CP_AIR) !--------------------------------------------------------------------- ! cloud liquid, ice and area tendencies due to convection: !--------------------------------------------------------------------- if (do_strat) then !--------------------------------------------------------------------- ! if cloud liquid diagnostics requested: !--------------------------------------------------------------------- if (id_qldt_conv > 0 .or. id_ql_conv_col > 0) then temp_3d1 = rdt(:,:,:,nql) - rdt_init(is:ie,js:je,:,nql) !--------------------------------------------------------------------- ! cloud liquid tendency due to convection: !--------------------------------------------------------------------- used = send_data (id_qldt_conv, temp_3d1, Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! cloud liquid water path tendency due to convection: !--------------------------------------------------------------------- if (id_ql_conv_col > 0) call column_diag(id_ql_conv_col, is, js, Time, temp_3d1, 1.0) endif !--------------------------------------------------------------------- ! if cloud drop diagnostics requested: !--------------------------------------------------------------------- if (id_qndt_conv > 0 .or. id_qn_conv_col > 0) then temp_3d1 = rdt(:,:,:,nqn) - rdt_init(is:ie,js:je,:,nqn) !--------------------------------------------------------------------- ! cloud drop tendency due to convection: !--------------------------------------------------------------------- used = send_data (id_qndt_conv, temp_3d1, Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! cloud drop water path tendency due to convection: !--------------------------------------------------------------------- if (id_qn_conv_col > 0) call column_diag(id_qn_conv_col, is, js, Time, temp_3d1, 1.0) endif !--------------------------------------------------------------------- ! if cloud ice diagnostics requested: !--------------------------------------------------------------------- if (id_qidt_conv > 0 .or. id_qi_conv_col > 0) then temp_3d1 = rdt(:,:,:,nqi) - rdt_init(is:ie,js:je,:,nqi) !--------------------------------------------------------------------- ! cloud ice tendency due to convection: !--------------------------------------------------------------------- used = send_data (id_qidt_conv, temp_3d1, Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! cloud ice water path tendency due to convection: !--------------------------------------------------------------------- if (id_qi_conv_col > 0) call column_diag(id_qi_conv_col, is, js, Time, temp_3d1, 1.0) endif !--------------------------------------------------------------------- ! if cloud area diagnostics requested: !--------------------------------------------------------------------- if (id_qadt_conv > 0 .or. id_qa_conv_col > 0 ) then temp_3d1 = rdt(:,:,:,nqa) - rdt_init(is:ie,js:je,:,nqa) !--------------------------------------------------------------------- ! cloud area tendency due to convection: !--------------------------------------------------------------------- used = send_data (id_qadt_conv, temp_3d1, Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! column integrated cloud mass tendency due to convection: !--------------------------------------------------------------------- if (id_qa_conv_col > 0) call column_diag(id_qa_conv_col, is, js, Time, temp_3d1, 1.0) endif endif !(do_strat) !--------------------------------------------------------------------- ! column integrated enthalpy and total water tendencies due to ! convection parameterization: !--------------------------------------------------------------------- if (id_enth_conv_col > 0 .or. id_wat_conv_col > 0) then temp_3d1 = rdt(:,:,:,nql) - rdt_init(is:ie,js:je,:,nql) temp_3d2 = rdt(:,:,:,nqi) - rdt_init(is:ie,js:je,:,nqi) if (id_enth_conv_col > 0) then temp_2d = -HLV*precip -HLF*fprec call column_diag(id_enth_conv_col, is, js, Time, ttnd_conv(is:ie,js:je,:), CP_AIR, temp_3d1, -HLV, temp_3d2, -HLS, temp_2d) endif if (id_wat_conv_col > 0) then temp_2d = precip call column_diag(id_wat_conv_col, is, js, Time, qtnd_conv(is:ie,js:je,:), 1.0, temp_3d1, 1.0, temp_3d2, 1.0, temp_2d) endif endif !--------------------------------------------------------------------- ! tracer tendencies due to convection: !--------------------------------------------------------------------- do n=1,size(rdt,4) if (tracers_in_donner(n) .or. tracers_in_ras(n) .or. & tracers_in_mca(n) .or. tracers_in_uw(n)) then if (id_tracerdt_conv(n) > 0 .or. id_tracerdt_conv_col(n) > 0) then temp_3d1 = rdt(:,:,:,n) - rdt_init(is:ie,js:je,:,n) used = send_data (id_tracerdt_conv(n), temp_3d1, Time, is, js, 1, rmask=mask ) !--------------------------------------------------------------------- ! tracer column tendencies due to convection: !--------------------------------------------------------------------- if (id_tracerdt_conv_col(n) > 0) & call column_diag(id_tracerdt_conv_col(n), is, js, Time, temp_3d1, 1.0) endif endif end do !--------------------------------------------------------------------- ! total convective updraft mass flux (uw + donner cell up + ! donner meso up !--------------------------------------------------------------------- used = send_data (id_mc_conv_up, cmf + mc_donner_up, Time, is, js, 1, rmask=mask ) !--------------------------------------------------------------------- ! end the timing of the convection code section. !--------------------------------------------------------------------- call mpp_clock_end (convection_clock) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! LARGE-SCALE CONDENSATION PARAMETERIZATIONS ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !--------------------------------------------------------------------- ! begin the timing of the large-scale condensation code section. !--------------------------------------------------------------------- !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! A. NON-PROGNOSTIC CONDENSATION PARAMETERIZATION ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !----------------------------------------------------------------------- ! if a non-prognostic cloud scheme is active, then call lscale_cond ! to calculate the temperature and specific humidity tendencies ! related to the latent heat release associated with the large-scale ! supersaturation. !----------------------------------------------------------------------- call mpp_clock_begin (largescale_clock) !zero out arrays for large scale precipitation rain = 0. snow = 0. rain3d = 0. snow3d = 0. snowclr3d = 0. ttnd(is:ie,js:je,:) = 0. qtnd(is:ie,js:je,:) = 0. if (do_lsc) then call mpp_clock_begin (lscalecond_clock) call moistproc_lscale_cond (is, js, tin(is:ie,js:je,:), qin(is:ie,js:je,:), pfull, phalf, tdt, qdt, & ttnd(is:ie,js:je,:), qtnd(is:ie,js:je,:), qtnd_conv(is:ie,js:je,:), lprec, fprec, precip, & rain, snow, dtinv, omega, do_rh_clouds, do_simple,& do_diag_clouds, coldT, kbot=kbot, mask=mask) call mpp_clock_end (lscalecond_clock) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! B. TIEDTKE / ROTSTAYN / KLEIN PROGNOSTIC CLOUD SCHEME ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ else if (do_strat) then call mpp_clock_begin (stratcloud_clock) call moistproc_strat_cloud(Time, is, ie, js, je, ktop, dt, tm, tin(is:ie,js:je,:), qin(is:ie,js:je,:), tracer(is:ie,js:je,:,:), & pfull, phalf, zhalf, omega, radturbten, mc_full(is:ie,js:je,:), & diff_t, land, area, tdt, qdt, rdt, q_tnd(is:ie,js:je,:,:), ttnd(is:ie,js:je,:), & qtnd(is:ie,js:je,:), lprec, fprec, rain, snow, rain3d, snow3d, & snowclr3d, & Aerosol, lsc_cloud_area, lsc_liquid, lsc_ice, & lsc_droplet_number, donner_humidity_area(is:ie,js:je,:), & donner_humidity_factor(is:ie,js:je,:), shallow_cloud_area, & cell_cld_frac, meso_cld_frac, & do_uw_conv, do_donner_deep, do_liq_num, & do_lin_cld_microphys, id_qvout, id_qlout, & id_qaout, id_qiout, limit_conv_cloud_frac, mask, & hydrostatic, phys_hydrostatic) call mpp_clock_end (stratcloud_clock) endif ! (do_lsc) !--------------------------------------------------------------------- ! calculate the wet deposition associated with the large scale ! condensation. !--------------------------------------------------------------------- qtnd_wet(is:ie,js:je,:) = qtnd(is:ie,js:je,:) if (do_strat) then qtnd_wet(is:ie,js:je,:) = qtnd_wet(is:ie,js:je,:) + q_tnd(is:ie,js:je,:,nql) + q_tnd(is:ie,js:je,:,nqi) ! Count precipitation formed over timestep plus cloud amount at end of timestep if (do_lin_cld_microphys) then cloud_wet(is:ie,js:je,:) = tracer(is:ie,js:je,:,nqr) + tracer(is:ie,js:je,:,nqs) + tracer(is:ie,js:je,:,nqg) else cloud_wet(is:ie,js:je,:) = rain3d(:,:,2:kx+1) - rain3d(:,:,1:kx) & + snow3d(:,:,2:kx+1) - snow3d(:,:,1:kx) cloud_wet(is:ie,js:je,:) = cloud_wet(is:ie,js:je,:) * dt / pmass(is:ie,js:je,:) ! convert from kg/m2/s to kg/kg endif cloud_wet(is:ie,js:je,:) = cloud_wet(is:ie,js:je,:) + tracer(is:ie,js:je,:,nql) + tracer(is:ie,js:je,:,nqi) cloud_frac(is:ie,js:je,:) = max( min( tracer(is:ie,js:je,:,nqa), 1. ), 0. ) else ! cloud_wet = qtnd_wet * dt cloud_wet(is:ie,js:je,:) = 0.5e-3 cloud_frac(is:ie,js:je,:) = 1. end if ls_wetdep = 0. do n=1,size(rdt,4) if ( n /= nsphum ) then if ( .not. do_strat .or. (n /= nql .and. n /= nqi .and. n /= nqa .and. n /= nqn) ) then wetdeptnd(is:ie,js:je,:) = 0.0 call wet_deposition( n, t, pfull, phalf, zfull, zhalf, rain, snow, & qtnd_wet(is:ie,js:je,:), cloud_wet(is:ie,js:je,:), cloud_frac(is:ie,js:je,:),rain3d, snow3d, & tracer(is:ie,js:je,:,n), wetdeptnd(is:ie,js:je,:), Time, 'lscale', & is, js, dt, sum_wdep_out=ls_wetdep(:,:,n) ) rdt (:,:,:,n) = rdt(:,:,:,n) - wetdeptnd(is:ie,js:je,:) wet_data(:,:,:,n) = wet_data(:,:,:,n) + wetdeptnd(is:ie,js:je,:) used = send_data( id_wet_deposition(n), wet_data(:,:,:,n), & Time,is_in=is,js_in=js ) end if end if end do !--------------------------------------------------------------------- ! output diagnostics associated with the large-scale condensation ! scheme. !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! temperature change due to large-scale condensation: !--------------------------------------------------------------------- used = send_data (id_tdt_ls, ttnd(is:ie,js:je,:), Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! dry static energy tendency due to large-scale condensation: !--------------------------------------------------------------------- if (id_t_ls_col > 0) & call column_diag(id_t_ls_col, is, js, Time, ttnd(is:ie,js:je,:), CP_AIR) !--------------------------------------------------------------------- ! water vapor path tendency due to large-scale condensation: !--------------------------------------------------------------------- if (id_q_ls_col > 0) & call column_diag(id_q_ls_col, is, js, Time, qtnd(is:ie,js:je,:), 1.0) !--------------------------------------------------------------------- ! specific humidity change due to large-scale condensation: !--------------------------------------------------------------------- used = send_data (id_qdt_ls, qtnd(is:ie,js:je,:), Time, is, js, 1, rmask=mask) used = send_data (id_lsc_precip, rain + snow, Time, is, js) if (id_lsc_freq > 0) then ltemp = rain > 0. .or. snow > 0.0 temp_2d = 0. where (ltemp) temp_2d = 1. end where used = send_data (id_lsc_freq, temp_2d, Time, is, js) endif !--------------------------------------------------------------------- ! total precipitation rate due to large-scale condensation: !--------------------------------------------------------------------- used = send_data (id_prec_ls, rain+snow, Time, is, js) !--------------------------------------------------------------------- ! snowfall rate due to large-scale condensation: !--------------------------------------------------------------------- used = send_data (id_snow_ls, snow, Time, is, js) !--------------------------------------------------------------------- ! define diagnostics specific to the strat_cloud formulation: !--------------------------------------------------------------------- if (do_strat) then !--------------------------------------------------------------------- ! total cumulus mass flux due to strat_cloud parameterization: !--------------------------------------------------------------------- used = send_data (id_mc_full, mc_full(is:ie,js:je,:), Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! cloud liquid, ice and area tendencies due to strat_cloud ! parameterization: !--------------------------------------------------------------------- used = send_data (id_qldt_ls, q_tnd(is:ie,js:je,:,nql), Time, is, js, 1, rmask=mask) used = send_data (id_qndt_ls, q_tnd(is:ie,js:je,:,nqn), Time, is, js, 1, rmask=mask) used = send_data (id_qidt_ls, q_tnd(is:ie,js:je,:,nqi), Time, is, js, 1, rmask=mask) used = send_data (id_qadt_ls, q_tnd(is:ie,js:je,:,nqa), Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! cloud liquid and ice water path tendencies due to strat_cloud ! parameterization: !--------------------------------------------------------------------- if (id_ql_ls_col > 0) & call column_diag(id_ql_ls_col, is, js, Time, q_tnd(is:ie,js:je,:,nql), 1.0) if (id_qi_ls_col > 0) & call column_diag(id_qi_ls_col, is, js, Time, q_tnd(is:ie,js:je,:,nqi), 1.0) if (do_liq_num .and. id_qn_ls_col > 0) & call column_diag(id_qn_ls_col, is, js, Time, q_tnd(is:ie,js:je,:,nqn), 1.0) !--------------------------------------------------------------------- ! column integrated enthalpy and total water tendencies due to ! strat_cloud parameterization: !--------------------------------------------------------------------- if (id_enth_ls_col > 0) then temp_2d = -HLV*rain -HLS*snow call column_diag(id_enth_ls_col, is, js, Time, ttnd(is:ie,js:je,:), CP_AIR, & q_tnd(is:ie,js:je,:,nql), -HLV, q_tnd(is:ie,js:je,:,nqi), -HLS, temp_2d) endif if (id_wat_ls_col > 0) then temp_2d = rain+snow call column_diag(id_wat_ls_col, is, js, Time, qtnd(is:ie,js:je,:), 1.0, & q_tnd(is:ie,js:je,:,nql), 1.0, q_tnd(is:ie,js:je,:,nqi), 1.0, temp_2d) endif !--------------------------------------------------------------------- ! stratiform cloud volume tendency due to strat_cloud ! parameterization: !--------------------------------------------------------------------- if (id_qa_ls_col > 0) & call column_diag(id_qa_ls_col, is, js, Time, q_tnd(is:ie,js:je,:,nqa), 1.0) !--------------------------------------------------------------------- !---- diagnostics for large scale precip ----------- !--------------------------------------------------------------------- used = send_data(id_lscale_rain3d, rain3d, Time, is, js, 1) !--------------------------------------------------------------------- !---- diagnostics for large scale snow ------------- !--------------------------------------------------------------------- used = send_data(id_lscale_snow3d, snow3d, Time, is, js, 1) endif ! (do_strat) !--------------------------------------------------------------------- ! end the timing of the large-scale condensation code section. !--------------------------------------------------------------------- call mpp_clock_end (largescale_clock) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! GENERAL MOISTURE DIAGNOSTICS ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !-------------------------------------------------------------------- ! output diagnostics obtained from the combination of convective and ! large-scale parameterizations. !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! output diagnostics obtained from the combination of convective and ! large-scale parameterizations. !-------------------------------------------------------------------- total_wetdep(:,:,:) = 0. total_wetdep_donner(:,:,:) = 0. total_wetdep_uw (:,:,:) = 0. m=1 mm=1 do n=1, size(rdt,4) if (tracers_in_donner(n)) then total_wetdep(:,:,n) = total_wetdep(:,:,n) + & donner_wetdep(:,:,m) total_wetdep_donner(:,:,n) = donner_wetdep(:,:,m) m=m+1 endif if (tracers_in_uw(n)) then total_wetdep(:,:,n) = total_wetdep(:,:,n) + & uw_wetdep(:,:,mm) total_wetdep_uw (:,:,n) = uw_wetdep(:,:,mm) mm=mm+1 endif end do if (do_strat) then total_wetdep = total_wetdep + ls_wetdep endif do n=1, size(rdt,4) if (id_wetdep(n) > 0) then used = send_data (id_wetdep(n), total_wetdep(:,:,n), & Time, is, js) endif end do if (id_wetdep_om > 0) then used = send_data (id_wetdep_om, & total_wetdep (:,:,nomphilic) + & total_wetdep (:,:,nomphobic) , & Time, is,js) endif if (id_wetdep_SOA > 0) then used = send_data (id_wetdep_SOA, & total_wetdep(:,:,nSOA) , Time, is,js) endif if (id_wetdep_bc > 0) then used = send_data (id_wetdep_bc, & total_wetdep (:,:,nbcphilic) + & total_wetdep (:,:,nbcphobic) , & Time, is,js) endif if (id_wetdep_so4 > 0) then used = send_data (id_wetdep_so4, & (96.0/WTMAIR)*(total_wetdep_donner(:,:,nso4 ) + & total_wetdep_uw (:,:,nso4 )) + & 0.096*ls_wetdep (:,:,nso4 ) , & Time, is,js) endif if (id_wetdep_so2 > 0) then used = send_data (id_wetdep_so2, & (64.0/WTMAIR)*(total_wetdep_donner(:,:,nso2 ) + & total_wetdep_uw (:,:,nso2 )) + & 0.064*ls_wetdep (:,:,nso2 ) , & Time, is,js) endif if (id_wetdep_DMS > 0) then used = send_data (id_wetdep_DMS, & (62.0/WTMAIR)*(total_wetdep_donner(:,:,nDMS ) + & total_wetdep_uw (:,:,nDMS )) + & 0.062*ls_wetdep (:,:,nDMS ) , & Time, is,js) endif if (id_wetdep_NH4NO3 > 0) then used = send_data (id_wetdep_NH4NO3, & (18.0/WTMAIR)*(total_wetdep_donner(:,:,nnH4NO3 ) + & total_wetdep_donner(:,:,nNH4 ) + & total_wetdep_uw (:,:,nNH4NO3 ) + & total_wetdep_uw (:,:,nNH4 )) + & 0.018*(ls_wetdep (:,:,nNH4NO3 ) + & ls_wetdep (:,:,nNH4 )) , & Time, is,js) endif if (id_wetdep_salt > 0) then used = send_data (id_wetdep_salt , & (58.44/WTMAIR)*(total_wetdep_donner(:,:,nsalt1 ) + & total_wetdep_donner(:,:,nsalt2 ) + & total_wetdep_donner(:,:,nsalt3 ) + & total_wetdep_donner(:,:,nsalt4 ) + & total_wetdep_donner(:,:,nsalt5 ) + & total_wetdep_uw (:,:,nsalt1 ) + & total_wetdep_uw (:,:,nsalt2 ) + & total_wetdep_uw (:,:,nsalt3 ) + & total_wetdep_uw (:,:,nsalt4 ) + & total_wetdep_uw (:,:,nsalt5 )) + & 0.05844*(ls_wetdep (:,:,nsalt1 ) + & ls_wetdep (:,:,nsalt2 ) + & ls_wetdep (:,:,nsalt3 ) + & ls_wetdep (:,:,nsalt4 ) + & ls_wetdep (:,:,nsalt5 )) , & Time, is,js) endif if (id_wetdep_dust > 0) then used = send_data (id_wetdep_dust , & (58.44/WTMAIR)*(total_wetdep_donner(:,:,ndust1 ) + & total_wetdep_donner(:,:,ndust2 ) + & total_wetdep_donner(:,:,ndust3 ) + & total_wetdep_donner(:,:,ndust4 ) + & total_wetdep_donner(:,:,ndust5 ) + & total_wetdep_uw (:,:,ndust1 ) + & total_wetdep_uw (:,:,ndust2 ) + & total_wetdep_uw (:,:,ndust3 ) + & total_wetdep_uw (:,:,ndust4 ) + & total_wetdep_uw (:,:,ndust5 )) + & 0.05844*(ls_wetdep (:,:,ndust1 ) + & ls_wetdep (:,:,ndust2 ) + & ls_wetdep (:,:,ndust3 ) + & ls_wetdep (:,:,ndust4 ) + & ls_wetdep (:,:,ndust5 )) , & Time, is,js) endif !--------------------------------------------------------------------- ! total precipitation (all sources): !--------------------------------------------------------------------- precip = fprec + lprec if (id_precip > 0) then used = send_data (id_precip, precip, Time, is, js) endif !--------------------------------------------------------------------- ! snowfall rate due to all sources: !--------------------------------------------------------------------- used = send_data (id_snow_tot, fprec, Time, is, js) !--------------------------------------------------------------------- ! column integrated enthalpy and total water tendencies due to ! moist processes: !--------------------------------------------------------------------- if (id_enth_moist_col > 0 .or. id_max_enthalpy_imbal > 0) then temp_3d1 = tdt - tdt_init(is:ie,js:je,:) temp_3d2 = rdt(:,:,:,nql) - rdt_init(is:ie,js:je,:,nql) temp_3d3 = rdt(:,:,:,nqi) - rdt_init(is:ie,js:je,:,nqi) temp_2d(:,:) = -HLV*precip -HLF*fprec call column_diag(id_enth_moist_col, is, js, Time, temp_3d1, CP_AIR, temp_3d2, -HLV, temp_3d3, -HLS, temp_2d) if (id_max_enthalpy_imbal > 0) then max_enthalpy_imbal = max( abs(temp_2d), max_enthalpy_imbal ) used = send_data(id_max_enthalpy_imbal, max_enthalpy_imbal, Time, is, js) endif endif if (id_wat_moist_col > 0 .or. id_max_water_imbal > 0) then temp_3d1 = qdt - qdt_init(is:ie,js:je,:) temp_3d2 = rdt(:,:,:,nql) - rdt_init(is:ie,js:je,:,nql) temp_3d3 = rdt(:,:,:,nqi) - rdt_init(is:ie,js:je,:,nqi) temp_2d(:,:) = precip call column_diag(id_enth_moist_col, is, js, Time, temp_3d1, 1.0, temp_3d2, 1.0, temp_3d3, 1.0, temp_2d) if (id_max_water_imbal > 0) then max_water_imbal = max( abs(temp_2d), max_water_imbal ) used = send_data(id_max_water_imbal, max_water_imbal, Time, is, js) endif endif !--------------------------------------------------------------------- ! water vapor, liquid water and ice water column paths: !--------------------------------------------------------------------- if (id_WVP > 0) & call column_diag(id_WVP, is, js, Time, qin(is:ie,js:je,:), 1.0) if (id_LWP > 0 .and. do_strat) & call column_diag(id_LWP, is, js, Time, tracer(is:ie,js:je,:,nql), 1.0) if (id_IWP > 0 .and. do_strat) & call column_diag(id_IWP, is, js, Time, tracer(is:ie,js:je,:,nqi), 1.0) if (id_lsc_cloud_area > 0 .and. do_strat ) then used = send_data (id_lsc_cloud_area, 100.*lsc_cloud_area, Time, is, & js, 1, rmask=mask) end if !---------------------------------------------------------------------- ! define total convective cloud amount (grid-box mean). !---------------------------------------------------------------------- total_conv_cloud = 0. tot_conv_liq = 0. tot_conv_ice = 0. conv_cld_frac = 0. total_cloud_area = 0. if (do_strat) then total_cloud_area = total_cloud_area + lsc_cloud_area endif if (do_donner_deep) then total_conv_cloud = total_conv_cloud + & cell_cld_frac*cell_ice_amt + meso_cld_frac*meso_ice_amt + & cell_cld_frac*cell_liq_amt + meso_cld_frac*meso_liq_amt conv_cld_frac = conv_cld_frac + cell_cld_frac + meso_cld_frac total_cloud_area = total_cloud_area + cell_cld_frac + & meso_cld_frac tot_conv_liq = tot_conv_liq + cell_cld_frac*cell_liq_amt + & meso_cld_frac*meso_liq_amt tot_conv_ice = tot_conv_ice + cell_cld_frac*cell_ice_amt + & meso_cld_frac*meso_ice_amt endif if (do_uw_conv) then total_conv_cloud = total_conv_cloud + & shallow_cloud_area*shallow_ice + & shallow_cloud_area*shallow_liquid conv_cld_frac = conv_cld_frac + shallow_cloud_area total_cloud_area = total_cloud_area + shallow_cloud_area tot_conv_liq = tot_conv_liq + shallow_cloud_area*shallow_liquid tot_conv_ice = tot_conv_ice + shallow_cloud_area*shallow_ice endif if (id_lsc_liq_amt > 0 .and. do_strat ) then used = send_data (id_lsc_liq_amt, & lsc_liquid/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) end if if ( id_lsc_ice_amt > 0 .and. do_strat ) then used = send_data (id_lsc_ice_amt, & lsc_ice/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) end if used = send_data (id_tot_cloud_area, 100.*total_cloud_area, & Time, is, js, 1, rmask=mask) used = send_data (id_conv_cloud_area, 100.*conv_cld_frac, & Time, is, js, 1, rmask=mask) !--------------------------------------------------------------------- ! define the total cloud area. !--------------------------------------------------------------------- if (id_tot_cld_amt > 0 ) then tca2 = 1.0 do k=1,kx tca2(:,:) = tca2(:,:)*(1.0 - total_cloud_area(:,:,k)) end do tca2 = 100.*(1. - tca2) used = send_data (id_tot_cld_amt, tca2, Time, is, js) endif !--------------------------------------------------------------------- ! define the total and convective liquid and liquid water path. !--------------------------------------------------------------------- used = send_data (id_tot_liq_amt, & (lsc_liquid + tot_conv_liq)/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) used = send_data (id_conv_liq_amt, & tot_conv_liq /(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) call column_diag (id_LWP_all_clouds, is, js, Time, & lsc_liquid+tot_conv_liq, 1.0) !--------------------------------------------------------------------- ! define the total and convective ice and ice water path. !--------------------------------------------------------------------- used = send_data (id_tot_ice_amt, & (lsc_ice + tot_conv_ice)/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) used = send_data (id_conv_ice_amt, & tot_conv_ice/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) call column_diag (id_IWP_all_clouds, is, js, Time, & lsc_ice+tot_conv_ice, 1.0) !--------------------------------------------------------------------- ! define the total vapor, total water substance and condensate water ! path. !--------------------------------------------------------------------- used = send_data (id_tot_vapor, qin, Time, is, js, 1, rmask=mask) used = send_data (id_tot_h2o , & (qin(is:ie,js:je,:) + lsc_ice + tot_conv_ice + lsc_liquid + & tot_conv_liq)/(1.0 + total_conv_cloud), & Time, is, js, 1, rmask=mask) call column_diag(id_WP_all_clouds, is, js, Time, & lsc_ice + tot_conv_ice + lsc_liquid + tot_conv_liq, 1.0) !--------------------------------------------------------------------- ! column integrated cloud mass: !--------------------------------------------------------------------- if (id_AWP > 0 .and. do_strat) & call column_diag(id_AWP, is, js, Time, tracer(is:ie,js:je,:,nqa), 1.0) !--------------------------------------------------------------------- ! relative humidity: !--------------------------------------------------------------------- if (id_rh > 0) then if (.not. (do_rh_clouds .or. do_diag_clouds)) then call rh_calc (pfull, tin(is:ie,js:je,:), qin(is:ie,js:je,:), RH(is:ie,js:je,:), do_simple, mask) endif used = send_data (id_rh, rh(is:ie,js:je,:)*100., Time, is, js, 1, rmask=mask) endif !--------------------------------------------------------------------- ! relative humidity (CMIP formulation): !--------------------------------------------------------------------- if (id_rh_cmip > 0) then if (.not. (do_rh_clouds .or. do_diag_clouds)) then call rh_calc (pfull, tin(is:ie,js:je,:), qin(is:ie,js:je,:), & RH(is:ie,js:je,:), do_simple, do_cmip=.true., & mask=mask) endif used = send_data (id_rh_cmip, rh(is:ie,js:je,:)*100., & Time, is, js, 1, rmask=mask) endif !--------------------------------------------------------------------- ! saturation specific humidity: !--------------------------------------------------------------------- if (id_qs > 0) then call compute_qs (tin(is:ie,js:je,:), pfull, qsat(is:ie,js:je,:), q = qin(is:ie,js:je,:)) used = send_data (id_qs, qsat(is:ie,js:je,:), Time, is, js, 1, rmask=mask) endif !------- diagnostics for CAPE and CIN, !!-- compute and write out CAPE and CIN-- if ( id_cape > 0 .or. id_cin > 0) then !! calculate r rin(is:ie,js:je,:) = qin(is:ie,js:je,:)/(1.0 - qin(is:ie,js:je,:)) ! XXX rin is not mixing ratio when do_simple=.true. avgbl = .false. do j=js,je do i=is,ie call capecalcnew( kx, pfull(i,j,:), phalf(i,j,:), CP_AIR, RDGAS, RVGAS, & HLV, KAPPA, tin(i,j,:), rin(i,j,:), avgbl, cape(i,j), cin(i,j)) end do end do if (id_cape > 0) used = send_data ( id_cape, cape, Time, is, js ) if ( id_cin > 0 ) used = send_data ( id_cin, cin, Time, is, js ) end if !--------------------------------------------------------------------- ! output the global integral of precipitation in units of mm/day. !--------------------------------------------------------------------- prec_intgl(is:ie,js:je) = precip(:,:)*SECONDS_PER_DAY !---------------------------------------------------------------------- ! define the precip fluxes needed for input to the COSP simulator ! package. !--------------------------------------------------------------------- if (do_cosp) then !--------------------------------------------------------------------- ! define precip fluxes from convective schemes at each layer ! interface. (index 1 is model lid) !--------------------------------------------------------------------- liq_mesoh(is:ie,js:je,1) = 0. frz_mesoh(is:ie,js:je,1) = 0. liq_cellh(is:ie,js:je,1) = 0. frz_cellh(is:ie,js:je,1) = 0. ice_precflxh(is:ie,js:je,1) = 0. liq_precflxh(is:ie,js:je,1) = 0. mca_liqh(is:ie,js:je,1) = 0. mca_frzh(is:ie,js:je,1) = 0. do k=2, size(t,3)+1 liq_mesoh(is:ie,js:je,k) = liq_mesoh (is:ie,js:je,k-1) + & liq_meso (is:ie,js:je,k-1) frz_mesoh(is:ie,js:je,k) = frz_mesoh (is:ie,js:je,k-1) + & frz_meso (is:ie,js:je,k-1) liq_cellh(is:ie,js:je,k) = liq_cellh (is:ie,js:je,k-1) + & liq_cell (is:ie,js:je,k-1) frz_cellh(is:ie,js:je,k) = frz_cellh (is:ie,js:je,k-1) + & frz_cell (is:ie,js:je,k-1) ice_precflxh(is:ie,js:je,k) = & ice_precflxh(is:ie,js:je,k-1) + & ice_precflx(is:ie,js:je,k-1) liq_precflxh(is:ie,js:je,k) = & liq_precflxh(is:ie,js:je,k-1) + & liq_precflx(is:ie,js:je,k-1) if (include_donmca_in_cosp) then mca_liqh (is:ie,js:je,k) = mca_liqh (is:ie,js:je,k-1) + & mca_liq(is:ie,js:je,k-1) mca_frzh (is:ie,js:je,k) = mca_frzh (is:ie,js:je,k-1) + & mca_frz(is:ie,js:je,k-1) endif end do !-------------------------------------------------------------------- ! adjust precip fluxes to account for any negative values produced. ! precip contribution is determined as the negative of the moisture ! tendency, so at top of clouds a positive moisture tendency some- ! times results in a negative precipitation contribution. !-------------------------------------------------------------------- sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (liq_mesoh(i,j,k) > 0.0) then if (liq_mesoh(i,j,k) > ABS(sumneg)) then liq_mesoh(i,j,k) = liq_mesoh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + liq_mesoh(i,j,k) liq_mesoh(i,j,k) = 0. endif else sumneg = sumneg + liq_mesoh(i,j,k) liq_mesoh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (frz_mesoh(i,j,k) > 0.0) then if (frz_mesoh(i,j,k) > ABS(sumneg)) then frz_mesoh(i,j,k) = frz_mesoh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + frz_mesoh(i,j,k) frz_mesoh(i,j,k) = 0. endif else sumneg = sumneg + frz_mesoh(i,j,k) frz_mesoh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (liq_cellh(i,j,k) > 0.0) then if (liq_cellh(i,j,k) > ABS(sumneg)) then liq_cellh(i,j,k) = liq_cellh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + liq_cellh(i,j,k) liq_cellh(i,j,k) = 0. endif else sumneg = sumneg + liq_cellh(i,j,k) liq_cellh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (frz_cellh(i,j,k) > 0.0) then if (frz_cellh(i,j,k) > ABS(sumneg)) then frz_cellh(i,j,k) = frz_cellh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + frz_cellh(i,j,k) frz_cellh(i,j,k) = 0. endif else sumneg = sumneg + frz_cellh(i,j,k) frz_cellh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (ice_precflxh(i,j,k) > 0.0) then if (ice_precflxh(i,j,k) > ABS(sumneg)) then ice_precflxh(i,j,k) = ice_precflxh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + ice_precflxh(i,j,k) ice_precflxh(i,j,k) = 0. endif else sumneg = sumneg + ice_precflxh(i,j,k) ice_precflxh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (liq_precflxh(i,j,k) > 0.0) then if (liq_precflxh(i,j,k) > ABS(sumneg)) then liq_precflxh(i,j,k) = liq_precflxh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + liq_precflxh(i,j,k) liq_precflxh(i,j,k) = 0. endif else sumneg = sumneg + liq_precflxh(i,j,k) liq_precflxh(i,j,k) = 0. endif end do end do end do if (include_donmca_in_cosp) then sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (mca_liqh(i,j,k) > 0.0) then if (mca_liqh(i,j,k) > ABS(sumneg)) then mca_liqh(i,j,k) = mca_liqh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + mca_liqh(i,j,k) mca_liqh(i,j,k) = 0. endif else sumneg = sumneg + mca_liqh(i,j,k) mca_liqh(i,j,k) = 0. endif end do end do end do sumneg = 0. do k=2, size(t,3)+1 do j=js,je do i=is,ie if (mca_frzh(i,j,k) > 0.0) then if (mca_frzh(i,j,k) > ABS(sumneg)) then mca_frzh(i,j,k) = mca_frzh(i,j,k) + sumneg sumneg = 0. else sumneg = sumneg + mca_frzh(i,j,k) mca_frzh(i,j,k) = 0. endif else sumneg = sumneg + mca_frzh(i,j,k) mca_frzh(i,j,k) = 0. endif end do end do end do endif !---------------------------------------------------------------------- ! define the grid-box precip flux as the average of the interface ! fluxes. !---------------------------------------------------------------------- do k=1, size(t,3) do j=1, size(t,2) do i=1, size(t,1) if (donner_meso_is_largescale) then fl_lsrain(i,j,k) = & 0.5*(rain3d(i,j,k) + rain3d(i,j,k+1) + & liq_mesoh(i+is-1,j+js-1,k) + & liq_mesoh(i+is-1,j+js-1,k+1)) fl_lssnow(i,j,k) = & 0.5*(snowclr3d(i,j,k) + snowclr3d(i,j,k+1) + & frz_mesoh(i+is-1,j+js-1,k) + & frz_mesoh(i+is-1,j+js-1,k+1)) fl_ccrain(i,j,k) = & 0.5*(liq_cellh(i+is-1,j+js-1,k) + & liq_cellh(i+is-1,j+js-1,k+1) + & liq_precflxh(i+is-1,j+js-1,k) + & liq_precflxh(i+is-1,j+js-1,k+1)) fl_ccsnow(i,j,k) = & 0.5*(frz_cellh(i+is-1,j+js-1,k) + & frz_cellh(i+is-1,j+js-1,k+1) + & ice_precflxh(i+is-1,j+js-1,k) + & ice_precflxh(i+is-1,j+js-1,k+1)) else fl_lsrain(i,j,k) = & 0.5*(rain3d(i,j,k) + rain3d(i,j,k+1)) fl_lssnow(i,j,k) = & 0.5*(snowclr3d(i,j,k) + snowclr3d(i,j,k+1)) fl_ccrain(i,j,k) = & 0.5*(liq_mesoh(i+is-1,j+js-1,k) + & liq_mesoh(i+is-1,j+js-1,k+1) + & liq_cellh(i+is-1,j+js-1,k) + & liq_cellh(i+is-1,j+js-1,k+1) + & liq_precflxh(i+is-1,j+js-1,k) + & liq_precflxh(i+is-1,j+js-1,k+1)) fl_ccsnow(i,j,k) = & 0.5*(frz_mesoh(i+is-1,j+js-1,k) + & frz_mesoh(i+is-1,j+js-1,k+1) + & frz_cellh(i+is-1,j+js-1,k) + & frz_cellh(i+is-1,j+js-1,k+1) + & ice_precflxh(i+is-1,j+js-1,k) + & ice_precflxh(i+is-1,j+js-1,k+1)) endif if (include_donmca_in_cosp) then fl_ccsnow(i,j,k) = fl_ccsnow(i,j,k) + 0.5* & (mca_frzh(i+is-1,j+js-1,k) + & mca_frzh(i+is-1,j+js-1,k+1)) fl_ccrain(i,j,k) = fl_ccrain(i,j,k) + 0.5* & (mca_liqh(i+is-1,j+js-1,k) + & mca_liqh(i+is-1,j+js-1,k+1)) endif end do end do end do endif ! (do_cosp) !----------------------------------------------------------------------- end subroutine moist_processes !##################################################################### subroutine moist_processes_time_vary (dt) real, intent(in) :: dt if (do_donner_deep) then call donner_deep_time_vary (dt) endif end subroutine moist_processes_time_vary !##################################################################### subroutine moist_processes_endts (is, js) integer, intent(in) :: is,js if (do_donner_deep) then call donner_deep_endts endif call sum_diag_integral_field ('prec', prec_intgl) prec_intgl = 0.0 end subroutine moist_processes_endts !################################################################### !####################################################################### subroutine moist_processes_init ( id, jd, kd, lonb, latb, pref, & axes, Time, doing_donner, & doing_uw_conv, num_uw_tracers_out,& do_strat_out, do_cosp_in, & ! doing_uw_conv, & ! do_cosp_in, & donner_meso_is_largescale_in, & include_donmca_in_cosp_out) !----------------------------------------------------------------------- integer, intent(in) :: id, jd, kd, axes(4) real, dimension(:,:), intent(in) :: lonb, latb real, dimension(:), intent(in) :: pref type(time_type), intent(in) :: Time logical, intent(out) :: doing_donner, doing_uw_conv, & do_strat_out !logical, intent(out) :: doing_donner, doing_uw_conv integer, intent(out) :: num_uw_tracers_out logical, intent(in), optional :: & do_cosp_in, & donner_meso_is_largescale_in logical, intent(out), optional :: & include_donmca_in_cosp_out !----------------------------------------------------------------------- ! ! input ! -------- ! ! id, jd number of horizontal grid points in the global ! fields along the x and y axis, repectively. ! [integer] ! ! kd number of vertical points in a column of atmosphere !----------------------------------------------------------------------- integer :: unit,io,ierr, n, logunit character(len=80) :: scheme integer :: secs, days integer :: k !----------------------------------------------------------------------- if ( module_is_initialized ) return if (present(do_cosp_in)) then do_cosp = do_cosp_in else do_cosp = .false. endif if (present(donner_meso_is_largescale_in)) then donner_meso_is_largescale = donner_meso_is_largescale_in else donner_meso_is_largescale = .false. endif if ( file_exist('input.nml')) then unit = open_namelist_file ( ) ierr=1; do while (ierr /= 0) read (unit, nml=moist_processes_nml, iostat=io, end=10) ierr = check_nml_error(io,'moist_processes_nml') enddo 10 call close_file (unit) !--------- write version and namelist to standard log ------------ call write_version_number ( version, tagname ) logunit = stdlog() if ( mpp_pe() == mpp_root_pe() ) & write ( logunit, nml=moist_processes_nml ) if (present(include_donmca_in_cosp_out)) then include_donmca_in_cosp_out = include_donmca_in_cosp endif !------------------- dummy checks -------------------------------------- if ( do_cosp .and. .not. (do_donner_deep .and. & do_strat .and. do_uw_conv)) & call error_mesg ('moist_processes_init', & 'must activate do_donner_deep, do_strat and do_uw_conv & &when do_cosp is true', FATAL) if (include_donmca_in_cosp .and. (.not. do_donner_mca) ) & call error_mesg ('moist_processes_init', & 'want to include donmca in COSP when donmca is inactive', & FATAL) if ( do_mca .and. do_ras ) call error_mesg & ('moist_processes_init', & 'both do_mca and do_ras cannot be specified', FATAL) if ( do_mca .and. do_bm ) call error_mesg & ('moist_processes_init', & 'both do_mca and do_bm cannot be specified', FATAL) if ( do_ras .and. do_bm ) call error_mesg & ('moist_processes_init', & 'both do_bm and do_ras cannot be specified', FATAL) if ( do_bm .and. do_bmmass ) call error_mesg & ('moist_processes_init', & 'both do_bm and do_bmmass cannot be specified', FATAL) if ( do_bm .and. do_bmomp ) call error_mesg & ('moist_processes_init', & 'both do_bm and do_bmomp cannot be specified', FATAL) if ( do_bmomp .and. do_bmmass ) call error_mesg & ('moist_processes_init', & 'both do_bmomp and do_bmmass cannot be specified', FATAL) if ( do_bmmass .and. do_mca ) call error_mesg & ('moist_processes_init', & 'both do_bmmass and do_mca cannot be specified', FATAL) if ( do_bmmass .and. do_ras ) call error_mesg & ('moist_processes_init', & 'both do_bmmass and do_ras cannot be specified', FATAL) if ( do_bmomp .and. do_mca ) call error_mesg & ('moist_processes_init', & 'both do_bmomp and do_mca cannot be specified', FATAL) if ( do_bmomp .and. do_ras ) call error_mesg & ('moist_processes_init', & 'both do_bmomp and do_ras cannot be specified', FATAL) if ( do_lsc .and. do_strat ) call error_mesg & ('moist_processes_init', & 'both do_lsc and do_strat cannot be specified', FATAL) if (.not. do_lsc .and. .not. do_strat) then call error_mesg ('moist_processes_mod', & 'must activate either do_lsc or do_strat in order to & &include large-scale condensation', FATAL) endif if ( (do_rh_clouds.or.do_diag_clouds) .and. do_strat .and. & mpp_pe() == mpp_root_pe() ) call error_mesg ('moist_processes_init', & 'do_rh_clouds or do_diag_clouds + do_strat should not be specified', NOTE) if ( do_rh_clouds .and. do_diag_clouds .and. mpp_pe() == mpp_root_pe() ) & call error_mesg ('moist_processes_init', & 'do_rh_clouds and do_diag_clouds should not be specified', NOTE) if (do_mca .and. do_donner_deep) call error_mesg & ('moist_processes_init', & 'both do_donner_deep and do_mca cannot be specified', FATAL) if (do_donner_deep .and. do_rh_clouds) then call error_mesg ('moist_processes_init', & 'Cannot currently activate donner_deep_mod with rh_clouds', FATAL) endif if (force_donner_moist_conserv .and. & .not. do_donner_conservation_checks) then call error_mesg ('moist_processes', & 'when force_donner_moist_conserv is .true., & &do_donner_conservation_checks must be .true.', FATAL) endif if (use_updated_profiles_for_uw .and. & .not. (do_donner_before_uw) ) then call error_mesg ('moist_processes_init', & 'use_updated_profiles_for_uw is only meaningful when & &do_donner_before_uw is true', FATAL) endif if (only_one_conv_scheme_per_column .and. & .not. (do_donner_before_uw) ) then call error_mesg ('moist_processes_init', & 'only_one_conv_scheme_per_column is only meaningful when & &do_donner_before_uw is true', FATAL) endif if (limit_conv_cloud_frac .and. & .not. do_donner_before_uw) then call error_mesg ('moist_processes', & 'when limit_conv_cloud_frac is .true., & &do_donner_before_uw must be .true.', FATAL) endif endif !--------------------------------------------------------------------- ! --- Find the tracer indices !--------------------------------------------------------------------- if (do_strat) then ! get tracer indices for stratiform cloud variables nsphum = 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' ) if (min(nql,nqi,nqa) <= 0) call error_mesg ('moist_processes', & 'stratiform cloud tracer(s) not found', FATAL) if (nql == nqi .or. nqa == nqi .or. nql == nqa) call error_mesg ('moist_processes', & 'tracers indices cannot be the same (i.e., nql=nqi=nqa).', FATAL) if (mpp_pe() == mpp_root_pe()) & write (logunit,'(a,3i4)') 'Stratiform cloud tracer indices: nql,nqi,nqa =',nql,nqi,nqa endif nqn = get_tracer_index ( MODEL_ATMOS, 'liq_drp' ) if (nqn == NO_TRACER .and. do_liq_num ) & call error_mesg ('moist_processes', & 'prognostic droplet number scheme requested but tracer not found', FATAL) !------------ initialize various schemes ---------- if (do_lsc) then call lscale_cond_init () if (do_rh_clouds) call rh_clouds_init (id,jd,kd) if (do_diag_clouds) call diag_cloud_init (id,jd,kd,ierr) endif if (do_strat) call strat_cloud_init (axes,Time,id,jd,kd) if (do_dryadj) call dry_adj_init () if (do_cmt) call cu_mo_trans_init (axes,Time, doing_diffusive) if (do_bm) call betts_miller_init () if (do_bmmass) call bm_massflux_init() if (do_bmomp) call bm_omp_init () if (do_cmt) then if ( .not. do_ras .and. .not. do_donner_deep .and. & .not. do_uw_conv) then call error_mesg ( 'moist_processes_mod', & 'do_cmt specified but no cumulus schemes activated', & FATAL) endif if (trim(cmt_mass_flux_source) == 'ras') then cmt_uses_ras = .true. cmt_uses_donner = .false. cmt_uses_uw = .false. if (.not. do_ras) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_ras then ras_mod must be active', FATAL) endif else if (trim(cmt_mass_flux_source) == 'donner') then cmt_uses_ras = .false. cmt_uses_donner = .true. cmt_uses_uw = .false. if (.not. do_donner_deep) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_donner then donner_deep_mod must& & be active', FATAL) endif else if (trim(cmt_mass_flux_source) == 'uw') then cmt_uses_ras = .false. cmt_uses_donner = .false. cmt_uses_uw = .true. if (.not. do_uw_conv) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_uw then uw_conv_mod must& & be active', FATAL) endif else if (trim(cmt_mass_flux_source) == 'donner_and_ras') then cmt_uses_ras = .true. if (.not. do_ras) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_ras then ras_mod must be active', FATAL) endif cmt_uses_donner = .true. if (.not. do_donner_deep) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_donner then donner_deep_mod must& & be active', FATAL) endif cmt_uses_uw = .false. else if (trim(cmt_mass_flux_source) == 'donner_and_uw') then cmt_uses_uw = .true. if (.not. do_uw_conv) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_uw then uw_conv_mod must be active', FATAL) endif cmt_uses_donner = .true. if (.not. do_donner_deep) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_donner then donner_deep_mod must& & be active', FATAL) endif cmt_uses_ras = .false. else if (trim(cmt_mass_flux_source) == 'ras_and_uw') then cmt_uses_ras = .true. if (.not. do_ras) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_ras then ras_mod must be active', FATAL) endif cmt_uses_uw = .true. if (.not. do_uw_conv) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_uw then uw_conv_mod must& & be active', FATAL) endif cmt_uses_donner = .false. else if (trim(cmt_mass_flux_source) == 'donner_and_ras_and_uw') then cmt_uses_ras = .true. if (.not. do_ras) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_ras then ras_mod must be active', FATAL) endif cmt_uses_donner = .true. if (.not. do_donner_deep) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_donner then donner_deep_mod must& & be active', FATAL) endif cmt_uses_uw = .true. if (.not. do_uw_conv) then call error_mesg ('moist_processes_mod', & 'if cmt_uses_uw then uw_conv_mod must& & be active', FATAL) endif else if (trim(cmt_mass_flux_source) == 'all') then if (do_ras) then cmt_uses_ras = .true. else cmt_uses_ras = .false. endif if (do_donner_deep) then cmt_uses_donner = .true. else cmt_uses_donner = .false. endif if (do_uw_conv) then cmt_uses_uw = .true. else cmt_uses_uw = .false. endif else call error_mesg ('moist_processes_mod', & 'invalid specification of cmt_mass_flux_source', FATAL) endif if (cmt_uses_uw .and. .not. doing_diffusive) then call error_mesg ('moist_processes_mod', & 'currently cannot do non-local cmt with uw as mass & &flux_source', FATAL) endif endif !----- initialize quantities for global integral package ----- call diag_integral_field_init ('prec', 'f6.3') allocate (prec_intgl(id,jd)) !--------------------------------------------------------------------- ! define output variables indicating whether certain convection ! schemes have been activated. !--------------------------------------------------------------------- doing_donner = do_donner_deep doing_uw_conv = do_uw_conv !----- initialize clocks ----- convection_clock = mpp_clock_id( ' Physics_up: Moist Proc: Conv' , grain=CLOCK_MODULE ) largescale_clock = mpp_clock_id( ' Physics_up: Moist Proc: LS' , grain=CLOCK_MODULE ) donner_clock = mpp_clock_id( ' Moist Processes: Donner_deep' , grain=CLOCK_MODULE ) mca_clock = mpp_clock_id( ' Moist Processes: MCA' , grain=CLOCK_MODULE ) donner_mca_clock = mpp_clock_id( ' Moist Processes: Donner_MCA' , grain=CLOCK_MODULE ) ras_clock = mpp_clock_id( ' Moist Processes: RAS' , grain=CLOCK_MODULE ) closure_clock = mpp_clock_id( ' Moist Processes: conv_closure', grain=CLOCK_MODULE ) shallowcu_clock = mpp_clock_id( ' Moist Processes: Shallow_cu' , grain=CLOCK_MODULE ) cmt_clock = mpp_clock_id( ' Moist Processes: CMT' , grain=CLOCK_MODULE ) lscalecond_clock = mpp_clock_id( ' Moist Processes: lscale_cond' , grain=CLOCK_MODULE ) stratcloud_clock = mpp_clock_id( ' Moist Processes: Strat_cloud' , grain=CLOCK_MODULE ) bm_clock = mpp_clock_id( ' Moist Processes: Betts-Miller', grain=CLOCK_MODULE ) nbcphobic = get_tracer_index(MODEL_ATMOS,'bcphob') nbcphilic = get_tracer_index(MODEL_ATMOS,'bcphil') nomphobic = get_tracer_index(MODEL_ATMOS,'omphob') nomphilic = get_tracer_index(MODEL_ATMOS,'omphil') ndust1 = get_tracer_index(MODEL_ATMOS,'dust1') ndust2 = get_tracer_index(MODEL_ATMOS,'dust2') ndust3 = get_tracer_index(MODEL_ATMOS,'dust3') ndust4 = get_tracer_index(MODEL_ATMOS,'dust4') ndust5 = get_tracer_index(MODEL_ATMOS,'dust5') nsalt1 = get_tracer_index(MODEL_ATMOS,'ssalt1') nsalt2 = get_tracer_index(MODEL_ATMOS,'ssalt2') nsalt3 = get_tracer_index(MODEL_ATMOS,'ssalt3') nsalt4 = get_tracer_index(MODEL_ATMOS,'ssalt4') nsalt5 = get_tracer_index(MODEL_ATMOS,'ssalt5') nDMS = get_tracer_index(MODEL_ATMOS,'simpleDMS') if (nDMS == NO_TRACER) then nDMS = get_tracer_index(MODEL_ATMOS,'dms') endif nSO2 = get_tracer_index(MODEL_ATMOS,'simpleSO2') if (nSO2 == NO_TRACER) then nSO2 = get_tracer_index(MODEL_ATMOS,'so2') endif nSO4 = get_tracer_index(MODEL_ATMOS,'simpleSO4') if (nSO4 == NO_TRACER) then nSO4 = get_tracer_index(MODEL_ATMOS,'so4') endif nSOA = get_tracer_index(MODEL_ATMOS,'SOA') nNH4NO3 = get_tracer_index(MODEL_ATMOS,'nh4no3') nNH4 = get_tracer_index(MODEL_ATMOS,'nh4') !--------------------------------------------------------------------- ! retrieve the number of registered tracers in order to determine ! which tracers are to be convectively transported. !--------------------------------------------------------------------- call get_number_tracers (MODEL_ATMOS, num_prog= num_tracers) !--------------------------------------------------------------------- ! allocate logical arrays to indicate the tracers which are to be ! transported by the various available convective schemes. ! initialize these arrays to .false.. !--------------------------------------------------------------------- allocate (tracers_in_donner(num_tracers)) allocate (tracers_in_mca(num_tracers)) allocate (tracers_in_ras(num_tracers)) allocate (tracers_in_uw(num_tracers)) tracers_in_donner = .false. tracers_in_mca = .false. tracers_in_ras = .false. tracers_in_uw = .false. !---------------------------------------------------------------------- ! for each tracer, determine if it is to be transported by convect- ! ion, and the convection schemes that are to transport it. set a ! logical flag to .true. for each tracer that is to be transported by ! each scheme and increment the count of tracers to be transported ! by that scheme. !---------------------------------------------------------------------- do n=1, num_tracers if (query_method ('convection', MODEL_ATMOS, n, scheme)) then select case (scheme) case ("none") case ("donner") num_donner_tracers = num_donner_tracers + 1 tracers_in_donner(n) = .true. case ("mca") num_mca_tracers = num_mca_tracers + 1 tracers_in_mca(n) = .true. case ("ras") num_ras_tracers = num_ras_tracers + 1 tracers_in_ras(n) = .true. case ("uw") num_uw_tracers = num_uw_tracers + 1 tracers_in_uw(n) = .true. case ("donner_and_ras") num_donner_tracers = num_donner_tracers + 1 tracers_in_donner(n) = .true. num_ras_tracers = num_ras_tracers + 1 tracers_in_ras(n) = .true. case ("donner_and_mca") num_donner_tracers = num_donner_tracers + 1 tracers_in_donner(n) = .true. num_mca_tracers = num_mca_tracers + 1 tracers_in_mca(n) = .true. case ("mca_and_ras") num_mca_tracers = num_mca_tracers + 1 tracers_in_mca(n) = .true. num_ras_tracers = num_ras_tracers + 1 tracers_in_ras(n) = .true. case ("all") num_donner_tracers = num_donner_tracers + 1 tracers_in_donner(n) = .true. num_mca_tracers = num_mca_tracers + 1 tracers_in_mca(n) = .true. num_ras_tracers = num_ras_tracers + 1 tracers_in_ras(n) = .true. num_uw_tracers = num_uw_tracers + 1 tracers_in_uw(n) = .true. case default ! corresponds to "none" end select endif end do !-------------------------------------------------------------------- ! set a logical indicating if any tracers are to be transported by ! each of the available convection parameterizations. !-------------------------------------------------------------------- if (num_donner_tracers > 0) then do_tracers_in_donner = .true. else do_tracers_in_donner = .false. endif if (num_mca_tracers > 0) then do_tracers_in_mca = .true. else do_tracers_in_mca = .false. endif if (num_ras_tracers > 0) then do_tracers_in_ras = .true. else do_tracers_in_ras = .false. endif if (num_uw_tracers > 0) then do_tracers_in_uw = .true. else do_tracers_in_uw = .false. endif !--------------------------------------------------------------------- ! check for proper use of do_unified_convective_closure. !--------------------------------------------------------------------- if (do_unified_convective_closure) then call error_mesg ('moist_processes_init', & 'do_unified_convective_closure is currently not allowed & & - see rsh', FATAL) endif if (do_unified_convective_closure) then if (.not. (do_donner_deep) .or. .not. (do_uw_conv) & .or. do_ras .or. do_mca ) then call error_mesg ('moist_processes_init', & 'must have only donner_deep and uw shallow activated & &when do_unified_convective_closure is .true.', FATAL) endif endif !--------------------------------------------------------------------- ! allocate and initialize arrays to hold maximum enthalpy and water ! imbalances in each column. !--------------------------------------------------------------------- allocate (max_enthalpy_imbal (id, jd)) allocate (max_water_imbal (id, jd)) max_enthalpy_imbal = 0. max_water_imbal = 0. !-------------------------------------------------------------------- ! initialize the convection scheme modules. !-------------------------------------------------------------------- if (do_donner_deep) then call get_time (Time, secs, days) call donner_deep_init (lonb, latb, pref, axes, secs, days, & tracers_in_donner, & do_donner_conservation_checks, & do_unified_convective_closure, using_fms) if (do_donner_conservation_checks) then allocate (max_enthalpy_imbal_don (id, jd)) allocate (max_water_imbal_don (id, jd)) max_enthalpy_imbal_don = 0. max_water_imbal_don = 0. endif endif ! (do_donner_deep) if (do_ras) then call ras_init (do_strat, do_liq_num, axes,Time, tracers_in_ras) endif if (do_uw_conv) call uw_conv_init (do_strat, axes, Time, kd, & tracers_in_uw) if (do_mca .or. do_donner_deep) then call moist_conv_init (axes,Time, tracers_in_mca) endif !----- initialize quantities for diagnostics output ----- call diag_field_init ( axes, Time, num_tracers, num_donner_tracers ) if (do_lin_cld_microphys) then if (.not. do_strat) call error_mesg ('moist_processes_init', & 'must also activate do_strat when do_lin_cld_microphys is active', FATAL) if (do_liq_num) call error_mesg ('moist_processes_init', & 'do_lin_cld_microphys cannot be active with prognostic droplet & & scheme (do_liq_num)', FATAL) nqr = get_tracer_index (MODEL_ATMOS, 'rainwat') nqs = get_tracer_index (MODEL_ATMOS, 'snowwat') nqg = get_tracer_index (MODEL_ATMOS, 'graupel') call lin_cld_microphys_init (axes, Time) ktop = 1 do k = 1, kd if (pref(k) > 10.E2) then ktop=k exit endif enddo if (mpp_pe() == mpp_root_pe()) & write(*,*) 'Top layer for lin_cld_microphys=', ktop, pref(ktop) endif num_uw_tracers_out = num_uw_tracers do_strat_out = do_strat module_is_initialized = .true. !----------------------------------------------------------------------- end subroutine moist_processes_init !####################################################################### subroutine moist_processes_end if( .not.module_is_initialized ) return !----------------close various schemes----------------- if (do_strat) call strat_cloud_end if (do_rh_clouds) call rh_clouds_end if (do_diag_clouds) call diag_cloud_end if (do_donner_deep) call donner_deep_end if (do_cmt ) call cu_mo_trans_end if (do_ras ) call ras_end if (do_uw_conv ) call uw_conv_end if (do_lin_cld_microphys) call lin_cld_microphys_end deallocate (max_water_imbal) deallocate (max_enthalpy_imbal) if (do_donner_conservation_checks) then deallocate (max_water_imbal_don) deallocate (max_enthalpy_imbal_don) endif module_is_initialized = .false. !----------------------------------------------------------------------- end subroutine moist_processes_end !####################################################################### ! ! ! ! write out restart file. ! Arguments: ! timestamp (optional, intent(in)) : A character string that represents the model time, ! used for writing restart. timestamp will append to ! the any restart file name as a prefix. ! ! subroutine moist_processes_restart(timestamp) character(len=*), intent(in), optional :: timestamp if (do_strat) call strat_cloud_restart(timestamp) if (do_diag_clouds) call diag_cloud_restart(timestamp) if (do_donner_deep) call donner_deep_restart(timestamp) end subroutine moist_processes_restart ! NAME="moist_processes_restart" !####################################################################### subroutine diag_field_init ( axes, Time, num_tracers, num_donner_tracers ) integer, intent(in) :: axes(4) type(time_type), intent(in) :: Time integer, intent(in) :: num_donner_tracers integer, intent(in) :: num_tracers character(len=32) :: tracer_units, tracer_name character(len=128) :: diaglname integer, dimension(3) :: half = (/1,2,4/) integer :: n, nn !------------ initializes diagnostic fields in this module ------------- if ( any((/do_bm,do_bmmass,do_bmomp/)) ) then id_qref = register_diag_field ( mod_name, & 'qref', axes(1:3), Time, & 'Adjustment reference specific humidity profile', & 'kg/kg', missing_value=missing_value ) id_tref = register_diag_field ( mod_name, & 'tref', axes(1:3), Time, & 'Adjustment reference temperature profile', & 'K', missing_value=missing_value ) id_bmflag = register_diag_field (mod_name, & 'bmflag', axes(1:2), Time, & 'Betts-Miller flag', & 'no units', missing_value=missing_value ) id_klzbs = register_diag_field (mod_name, & 'klzbs', axes(1:2), Time, & 'klzb', & 'no units', missing_value=missing_value ) id_cape = register_diag_field ( mod_name, & 'cape', axes(1:2), Time, & 'Convectively available potential energy', 'J/Kg') id_cin = register_diag_field ( mod_name, & 'cin', axes(1:2), Time, & 'Convective inhibition', 'J/Kg') endif if ( do_bm ) then id_invtaubmt = register_diag_field (mod_name, & 'invtaubmt', axes(1:2), Time, & 'Inverse temperature relaxation time', & '1/s', missing_value=missing_value ) id_invtaubmq = register_diag_field (mod_name, & 'invtaubmq', axes(1:2), Time, & 'Inverse humidity relaxation time', & '1/s', missing_value=missing_value ) end if ! if ( do_bm ) if (do_bmmass) then id_massflux = register_diag_field (mod_name, & 'massflux', axes(1:3), Time, & 'Massflux implied by temperature adjustment', & 'm/s', missing_value=missing_value ) end if ! if ( do_bmmass ) id_ras_precip = register_diag_field ( mod_name, & 'ras_precip', axes(1:2), Time, & 'Precipitation rate from ras ', 'kg/m2/s' ) id_ras_freq = register_diag_field ( mod_name, & 'ras_freq', axes(1:2), Time, & 'frequency of precip from ras ', 'number' , & missing_value = missing_value ) id_don_precip = register_diag_field ( mod_name, & 'don_precip', axes(1:2), Time, & 'Precipitation rate from donner ', 'kg/m2/s' ) id_don_freq = register_diag_field ( mod_name, & 'don_freq', axes(1:2), Time, & 'frequency of precip from donner ', 'number', & missing_value = missing_value ) id_lsc_precip = register_diag_field ( mod_name, & 'lsc_precip', axes(1:2), Time, & 'Precipitation rate from lsc ', 'kg/m2/s' ) id_lsc_freq = register_diag_field ( mod_name, & 'lsc_freq', axes(1:2), Time, & 'frequency of precip from lsc ', 'number' , & missing_value = missing_value ) id_uw_precip = register_diag_field ( mod_name, & 'uw_precip', axes(1:2), Time, & 'Precipitation rate from uw shallow', 'kg/m2/s', & interp_method = "conserve_order1" ) id_uw_snow = register_diag_field ( mod_name, & 'uw_snow', axes(1:2), Time, & 'Snow rate from uw shallow', 'kg/m2/s' , & interp_method = "conserve_order1" ) id_uw_freq = register_diag_field ( mod_name, & 'uw_freq', axes(1:2), Time, & 'frequency of precip from uw shallow ', 'number' , & missing_value = missing_value ) id_tdt_conv = register_diag_field ( mod_name, & 'tdt_conv', axes(1:3), Time, & 'Temperature tendency from convection ', 'deg_K/s', & missing_value=missing_value ) id_qdt_conv = register_diag_field ( mod_name, & 'qdt_conv', axes(1:3), Time, & 'Spec humidity tendency from convection ', 'kg/kg/s', & missing_value=missing_value ) id_q_conv_col = register_diag_field ( mod_name, & 'q_conv_col', axes(1:2), Time, & 'Water vapor path tendency from convection ', 'kg/m2/s' ) id_t_conv_col = register_diag_field ( mod_name, & 't_conv_col', axes(1:2), Time, & 'Column static energy tendency from convection ','W/m2' ) id_enth_conv_col = register_diag_field ( mod_name, & 'enth_conv_col', axes(1:2), Time, & 'Column enthalpy tendency from convection','W/m2' ) id_wat_conv_col = register_diag_field ( mod_name, & 'wat_conv_col', axes(1:2), Time, & 'Column total water tendency from convection','kg(h2o)/m2/s' ) id_enth_donner_col2 = register_diag_field ( mod_name, & 'enth_donner_col2', axes(1:2), Time, & 'column enthalpy tendency from Donner liq precip','W/m2' ) id_enth_donner_col3 = register_diag_field ( mod_name, & 'enth_donner_col3', axes(1:2), Time, & 'Column enthalpy tendency from Donner frzn precip','W/m2' ) id_enth_donner_col4 = register_diag_field ( mod_name, & 'enth_donner_col4', axes(1:2), Time, & 'Atmospheric column enthalpy tendency from Donner convection', & 'W/m2' ) id_enth_donner_col5 = register_diag_field ( mod_name, & 'enth_donner_col5', axes(1:2), Time, & 'Column enthalpy tendency due to condensate xfer from Donner & &to lsc','W/m2' ) id_enth_donner_col6 = register_diag_field ( mod_name, & 'enth_donner_col6', axes(1:2), Time, & 'Column enthalpy tendency from donner moisture & &conservation adjustment','W/m2' ) id_enth_donner_col7 = register_diag_field ( mod_name, & 'enth_donner_col7', axes(1:2), Time, & 'Precip adjustment needed to balance donner moisture & &adjustment','kg(h2o)/m2/s' ) id_enth_donner_col = register_diag_field ( mod_name, & 'enth_donner_col', axes(1:2), Time, & 'Column enthalpy imbalance from Donner convection','W/m2' ) id_wat_donner_col = register_diag_field ( mod_name, & 'wat_donner_col', axes(1:2), Time, & 'Column total water tendency from Donner convection','kg(h2o)/m2/s' ) id_enth_mca_donner_col = register_diag_field ( mod_name, & 'enth_mca_donner_col', axes(1:2), Time, & 'Column enthalpy imbalance from Donner MCA convection','W/m2' ) id_wat_mca_donner_col = register_diag_field ( mod_name, & 'wat_mca_donner_col', axes(1:2), Time, & 'Column total water imbalance from Donner MCA convection', & 'kg(h2o)/m2/s' ) id_enth_uw_col = register_diag_field ( mod_name, & 'enth_uw_col', axes(1:2), Time, & 'Column enthalpy tendency from UW convection','W/m2' ) id_wat_uw_col = register_diag_field ( mod_name, & 'wat_uw_col', axes(1:2), Time, & 'Column total water tendency from UW convection','kg(h2o)/m2/s' ) id_scale_uw = register_diag_field ( mod_name, & 'scale_uw', axes(1:2), Time, & 'Scaling factor applied to UW convection tendencies','1' ) id_scale_donner = register_diag_field ( mod_name, & 'scale_donner', axes(1:2), Time, & 'Scaling factor applied to UW convection tendencies','1' ) id_prec_conv = register_diag_field ( mod_name, & 'prec_conv', axes(1:2), Time, & 'Precipitation rate from convection ', 'kg(h2o)/m2/s', & interp_method = "conserve_order1" ) id_snow_conv = register_diag_field ( mod_name, & 'snow_conv', axes(1:2), Time, & 'Frozen precip rate from convection ', 'kg(h2o)/m2/s', & interp_method = "conserve_order1" ) id_snow_tot = register_diag_field ( mod_name, & 'snow_tot ', axes(1:2), Time, & 'Frozen precip rate from all sources', 'kg(h2o)/m2/s', & interp_method = "conserve_order1" ) id_conv_freq = register_diag_field ( mod_name, & 'conv_freq', axes(1:2), Time, & 'frequency of convection ', 'number', & missing_value = missing_value ) id_gust_conv = register_diag_field ( mod_name, & 'gust_conv', axes(1:2), Time, & 'Gustiness resulting from convection ', 'm/s' ) id_conv_rain3d= register_diag_field ( mod_name, & 'conv_rain3d', axes(half), Time, & 'Rain fall rate from convection -3D ', 'kg(h2o)/m2/s' ) id_conv_snow3d= register_diag_field ( mod_name, & 'conv_snow3d', axes(half), Time, & 'Snow fall rate from convection -3D', 'kg(h2o)/m2/s' ) id_lscale_rain3d= register_diag_field ( mod_name, & 'lscale_rain3d', axes(half), Time, & 'Rain fall rate from lscale -3D ', 'kg(h2o)/m2/s' ) id_lscale_snow3d= register_diag_field ( mod_name, & 'lscale_snow3d', axes(half), Time, & 'Snow fall rate from lscale -3D', 'kg(h2o)/m2/s' ) id_max_enthalpy_imbal = register_diag_field & (mod_name, 'max_enth_imbal', axes(1:2), Time, & 'max enthalpy imbalance from moist_processes ', 'W/m2', & missing_value=missing_value) id_max_water_imbal = register_diag_field & (mod_name, 'max_water_imbal', axes(1:2), Time, & 'max water imbalance from moist_processes ', 'kg(h2o)/m2/s', & missing_value=missing_value) id_enth_moist_col = register_diag_field ( mod_name, & 'enth_moist_col', axes(1:2), Time, & 'Column enthalpy imbalance from moist processes','W/m2' ) id_wat_moist_col = register_diag_field ( mod_name, & 'wat_moist_col', axes(1:2), Time, & 'Column total water imbalance from moist processes','kg/m2/s' ) if (do_donner_conservation_checks) then id_enthint = register_diag_field & (mod_name, 'enthint_don', axes(1:2), Time, & 'atmospheric column enthalpy change from donner', 'W/m2', & missing_value=missing_value) id_lcondensint = register_diag_field & (mod_name, 'lcondensint_don', axes(1:2), Time, & 'enthalpy transferred by condensate from donner to lscale', & 'W/m2', missing_value=missing_value) id_lprcp = register_diag_field & (mod_name, 'lprcpint_don', axes(1:2), & Time, 'enthalpy removed by donner precip', 'W/m2', & missing_value=missing_value) id_vertmotion = register_diag_field & (mod_name, 'vertmotion_don', axes(1:2), Time, & 'enthalpy change due to cell and meso motion in donner', & 'W/m2', missing_value=missing_value) id_enthdiffint = register_diag_field & (mod_name, 'enthdiffint_don', axes(1:2), & Time, 'enthalpy imbalance due to donner', 'W/m2', & missing_value=missing_value) id_vaporint = register_diag_field & (mod_name, 'vaporint_don', axes(1:2), & Time, 'column water vapor change', 'kg(h2o)/m2/s', & missing_value=missing_value) id_max_enthalpy_imbal_don = register_diag_field & (mod_name, 'max_enth_imbal_don', axes(1:2), & Time, 'max enthalpy imbalance from donner', 'W/m**2', & missing_value=missing_value) id_max_water_imbal_don = register_diag_field & (mod_name, 'max_water_imbal_don', axes(1:2), & Time, 'max water imbalance from donner', 'kg(h2o)/m2/s', & missing_value=missing_value) id_condensint = register_diag_field & (mod_name, 'condensint_don', axes(1:2), Time, & 'column condensate exported from donner to lscale', & 'kg(h2o)/m2/s', missing_value=missing_value ) id_precipint = register_diag_field & (mod_name, 'precipint_don', axes(1:2), & Time, 'column precip from donner', 'kg(h2o)/m2/s', & missing_value=missing_value) id_diffint = register_diag_field & (mod_name, 'diffint_don', axes(1:2), & Time, 'water imbalance due to donner', 'kg(h2o)/m2/s', & missing_value=missing_value) endif if (do_strat ) then id_qldt_conv = register_diag_field ( mod_name, & 'qldt_conv', axes(1:3), Time, & 'Liquid water tendency from convection', 'kg/kg/s', & missing_value=missing_value ) id_qndt_conv = register_diag_field ( mod_name, & 'qndt_conv', axes(1:3), Time, & 'Liquid drop tendency from convection', '#/kg/s', & missing_value=missing_value ) id_qidt_conv = register_diag_field ( mod_name, & 'qidt_conv', axes(1:3), Time, & 'Ice water tendency from convection', 'kg/kg/s', & missing_value=missing_value ) id_qadt_conv = register_diag_field ( mod_name, & 'qadt_conv', axes(1:3), Time, & 'Cloud fraction tendency from convection', '1/sec', & missing_value=missing_value ) id_ql_conv_col = register_diag_field ( mod_name, & 'ql_conv_col', axes(1:2), Time, & 'Liquid water path tendency from convection', 'kg/m2/s' ) id_qn_conv_col = register_diag_field ( mod_name, & 'qn_conv_col', axes(1:2), Time, & 'Liquid drp tendency from convection', 'kg/m2/s' ) id_qi_conv_col = register_diag_field ( mod_name, & 'qi_conv_col', axes(1:2), Time, & 'Ice water path tendency from convection', 'kg/m2/s' ) id_qa_conv_col = register_diag_field ( mod_name, & 'qa_conv_col', axes(1:2), Time, & 'Cloud mass tendency from convection', 'kg/m2/s' ) endif if ( do_lsc ) then id_tdt_ls = register_diag_field ( mod_name, & 'tdt_ls', axes(1:3), Time, & 'Temperature tendency from large-scale cond', 'deg_K/s', & missing_value=missing_value ) id_qdt_ls = register_diag_field ( mod_name, & 'qdt_ls', axes(1:3), Time, & 'Spec humidity tendency from large-scale cond', 'kg/kg/s', & missing_value=missing_value ) id_prec_ls = register_diag_field ( mod_name, & 'prec_ls', axes(1:2), Time, & 'Precipitation rate from large-scale cond', 'kg/m2/s', & interp_method = "conserve_order1" ) id_snow_ls = register_diag_field ( mod_name, & 'snow_ls', axes(1:2), Time, & 'Frozen precip rate from large-scale cond', 'kg/m2/s', & interp_method = "conserve_order1" ) id_q_ls_col = register_diag_field ( mod_name, & 'q_ls_col', axes(1:2), Time, & 'Water vapor path tendency from large-scale cond','kg/m2/s' ) id_t_ls_col = register_diag_field ( mod_name, & 't_ls_col', axes(1:2), Time, & 'Column static energy tendency from large-scale cond','W/m2' ) endif id_conv_cld_base = register_diag_field ( mod_name, & 'conv_cld_base', axes(1:2), Time, & 'pressure at convective cloud base', 'Pa', & mask_variant = .true., & missing_value=missing_value ) id_conv_cld_top = register_diag_field ( mod_name, & 'conv_cld_top', axes(1:2), Time, & 'pressure at convective cloud top', 'Pa', & mask_variant = .true., & missing_value=missing_value ) if ( do_strat ) then id_mc_full = register_diag_field ( mod_name, & 'mc_full', axes(1:3), Time, & 'Net Mass Flux from convection', 'kg/m2/s', & missing_value=missing_value ) id_tdt_ls = register_diag_field ( mod_name, & 'tdt_ls', axes(1:3), Time, & 'Temperature tendency from strat cloud', 'deg_K/s', & missing_value=missing_value ) id_qdt_ls = register_diag_field ( mod_name, & 'qdt_ls', axes(1:3), Time, & 'Spec humidity tendency from strat cloud', 'kg/kg/s', & missing_value=missing_value ) id_prec_ls = register_diag_field ( mod_name, & 'prec_ls', axes(1:2), Time, & 'Precipitation rate from strat cloud', 'kg/m2/s' ) id_snow_ls = register_diag_field ( mod_name, & 'snow_ls', axes(1:2), Time, & 'Frozen precip rate from strat cloud', 'kg/m2/s' ) id_q_ls_col = register_diag_field ( mod_name, & 'q_ls_col', axes(1:2), Time, & 'Water vapor path tendency from strat cloud', 'kg/m2/s' ) id_t_ls_col = register_diag_field ( mod_name, & 't_ls_col', axes(1:2), Time, & 'Column static energy tendency from strat cloud','W/m2' ) id_qldt_ls = register_diag_field ( mod_name, & 'qldt_ls', axes(1:3), Time, & 'Liquid water tendency from strat cloud', 'kg/kg/s', & missing_value=missing_value ) id_qndt_ls = register_diag_field ( mod_name, & 'qndt_ls', axes(1:3), Time, & 'Drop number tendency from strat cloud', '#/kg/s', & missing_value=missing_value ) id_qidt_ls = register_diag_field ( mod_name, & 'qidt_ls', axes(1:3), Time, & 'Ice water tendency from strat cloud', 'kg/kg/s', & missing_value=missing_value ) id_qadt_ls = register_diag_field ( mod_name, & 'qadt_ls', axes(1:3), Time, & 'Cloud fraction tendency from strat cloud', '1/sec', & missing_value=missing_value ) id_ql_ls_col = register_diag_field ( mod_name, & 'ql_ls_col', axes(1:2), Time, & 'Liquid water path tendency from strat cloud', 'kg/m2/s' ) id_qn_ls_col = register_diag_field ( mod_name, & 'qn_ls_col', axes(1:2), Time, & 'Column drop number tendency from strat cloud', '#/m2/s' ) id_qi_ls_col = register_diag_field ( mod_name, & 'qi_ls_col', axes(1:2), Time, & 'Ice water path tendency from strat cloud', 'kg/m2/s' ) id_qa_ls_col = register_diag_field ( mod_name, & 'qa_ls_col', axes(1:2), Time, & 'Cloud mass tendency from strat cloud', 'kg/m2/s' ) id_enth_ls_col = register_diag_field ( mod_name, & 'enth_ls_col', axes(1:2), Time, & 'Column enthalpy tendency from strat cloud','W/m2' ) id_wat_ls_col = register_diag_field ( mod_name, & 'wat_ls_col', axes(1:2), Time, & 'Column total water tendency from strat cloud','kg/m2/s' ) endif id_precip = register_diag_field ( mod_name, & 'precip', axes(1:2), Time, & 'Total precipitation rate', 'kg/m2/s', & interp_method = "conserve_order1" ) id_WVP = register_diag_field ( mod_name, & 'WVP', axes(1:2), Time, & 'Column integrated water vapor', 'kg/m2' ) if ( do_strat ) then id_LWP = register_diag_field ( mod_name, & 'LWP', axes(1:2), Time, & 'Liquid water path', 'kg/m2' ) id_IWP = register_diag_field ( mod_name, & 'IWP', axes(1:2), Time, & 'Ice water path', 'kg/m2' ) id_AWP = register_diag_field ( mod_name, & 'AWP', axes(1:2), Time, & 'Column integrated cloud mass ', 'kg/m2' ) id_tot_cld_amt = register_diag_field & (mod_name, 'cld_amt_2d', axes(1:2), Time, & 'total cloud amount', 'percent') id_tot_cloud_area = register_diag_field ( mod_name, & 'tot_cloud_area', axes(1:3), Time, & 'Cloud area -- all clouds', 'percent', missing_value=missing_value ) id_tot_h2o = register_diag_field ( mod_name, & 'tot_h2o', axes(1:3), Time, & 'total h2o -- all phases', 'kg/kg', missing_value=missing_value) id_tot_vapor = register_diag_field ( mod_name, & 'tot_vapor', axes(1:3), Time, & 'total vapor', 'kg/kg', missing_value=missing_value) id_tot_liq_amt = register_diag_field ( mod_name, & 'tot_liq_amt', axes(1:3), Time, & 'Liquid amount -- all clouds', 'kg/kg', missing_value=missing_value) id_tot_ice_amt = register_diag_field ( mod_name, & 'tot_ice_amt', axes(1:3), Time, & 'Ice amount -- all clouds', 'kg/kg', missing_value=missing_value ) id_lsc_cloud_area = register_diag_field ( mod_name, & 'lsc_cloud_area', axes(1:3), Time, & 'Large-scale cloud area', 'percent', missing_value=missing_value ) id_lsc_liq_amt = register_diag_field ( mod_name, & 'lsc_liq_amt', axes(1:3), Time, & 'Large-scale cloud liquid amount', 'kg/kg', missing_value=missing_value ) id_lsc_ice_amt = register_diag_field ( mod_name, & 'lsc_ice_amt', axes(1:3), Time, & 'Large-scale cloud ice amount', 'kg/kg', missing_value=missing_value ) id_conv_cloud_area = register_diag_field ( mod_name, & 'conv_cloud_area', axes(1:3), Time, & 'Convective cloud area', 'percent', missing_value=missing_value ) id_conv_liq_amt = register_diag_field ( mod_name, & 'conv_liq_amt', axes(1:3), Time, & 'Convective cloud liquid amount', 'kg/kg', missing_value=missing_value ) id_conv_ice_amt = register_diag_field ( mod_name, & 'conv_ice_amt', axes(1:3), Time, & 'Convective cloud ice amount', 'kg/kg', missing_value=missing_value) id_WP_all_clouds = register_diag_field ( mod_name, & 'WP_all_clouds', axes(1:2), Time, & 'Total water path -- all clouds', 'kg/m2' ) id_LWP_all_clouds = register_diag_field ( mod_name, & 'LWP_all_clouds', axes(1:2), Time, & 'Liquid water path -- all clouds', 'kg/m2' ) id_IWP_all_clouds = register_diag_field ( mod_name, & 'IWP_all_clouds', axes(1:2), Time, & 'Ice water path -- all clouds', 'kg/m2' ) endif id_tdt_dadj = register_diag_field ( mod_name, & 'tdt_dadj', axes(1:3), Time, & 'Temperature tendency from dry conv adj', 'deg_K/s', & missing_value=missing_value ) id_rh = register_diag_field ( mod_name, & 'rh', axes(1:3), Time, & 'relative humidity', 'percent', & missing_value=missing_value ) id_rh_cmip = register_diag_field ( mod_name, & 'rh_cmip', axes(1:3), Time, & 'relative humidity', 'percent', & missing_value=missing_value ) id_qs = register_diag_field ( mod_name, & 'qs', axes(1:3), Time, & 'saturation specific humidity', 'kg/kg', & missing_value=missing_value ) if (do_donner_deep) then id_tdt_deep_donner= register_diag_field ( mod_name, & 'tdt_deep_donner', axes(1:3), Time, & ' heating rate - deep portion', 'deg K/s', & missing_value=missing_value ) id_qdt_deep_donner = register_diag_field ( mod_name, & 'qdt_deep_donner', axes(1:3), Time, & ' moistening rate - deep portion', 'kg/kg/s', & missing_value=missing_value ) id_qadt_deep_donner = register_diag_field ( mod_name, & 'qadt_deep_donner', axes(1:3), Time, & ' cloud amount tendency - deep portion', '1/s', & missing_value=missing_value ) id_qldt_deep_donner = register_diag_field ( mod_name, & 'qldt_deep_donner', axes(1:3), Time, & ' cloud liquid tendency - deep portion', 'kg/kg/s', & missing_value=missing_value ) id_qidt_deep_donner = register_diag_field ( mod_name, & 'qidt_deep_donner', axes(1:3), Time, & ' ice water tendency - deep portion', 'kg/kg/s', & missing_value=missing_value ) id_tdt_mca_donner = register_diag_field ( mod_name, & 'tdt_mca_donner', axes(1:3), Time, & ' heating rate - mca portion', 'deg K/s', & missing_value=missing_value ) id_qdt_mca_donner = register_diag_field ( mod_name, & 'qdt_mca_donner', axes(1:3), Time, & ' moistening rate - mca portion', 'kg/kg/s', & missing_value=missing_value ) id_prec_deep_donner = register_diag_field ( mod_name, & 'prc_deep_donner', axes(1:2), Time, & ' total precip rate - deep portion', 'kg/m2/s', & missing_value=missing_value, & interp_method = "conserve_order1" ) id_prec1_deep_donner = register_diag_field ( mod_name, & 'prc1_deep_donner', axes(1:2), Time, & ' change in precip for conservation in donner', 'kg/m2/s ', & missing_value=missing_value, mask_variant = .true., & interp_method = "conserve_order1" ) id_prec_mca_donner = register_diag_field ( mod_name, & 'prc_mca_donner', axes(1:2), Time, & ' total precip rate - mca portion', 'kg/m2/s', & missing_value=missing_value, & interp_method = "conserve_order1" ) id_snow_deep_donner = register_diag_field ( mod_name, & 'snow_deep_donner', axes(1:2), Time, & ' frozen precip rate - deep portion', 'kg/m2/s', & missing_value=missing_value, & interp_method = "conserve_order1" ) id_snow_mca_donner = register_diag_field ( mod_name, & 'snow_mca_donner', axes(1:2), Time, & ' frozen precip rate - mca portion', 'kg/m2/s', & missing_value=missing_value, & interp_method = "conserve_order1" ) id_mc_donner = register_diag_field ( mod_name, & 'mc_donner', axes(1:3), Time, & 'Net Mass Flux from donner', 'kg/m2/s', & missing_value=missing_value ) id_mc_conv_up = register_diag_field ( mod_name, & 'mc_conv_up', axes(1:3), Time, & 'Upward Mass Flux from convection', 'kg/m2/s', & missing_value=missing_value ) id_m_cdet_donner = register_diag_field ( mod_name, & 'm_cdet_donner', axes(1:3), Time, & 'Detrained Cell Mass Flux from donner', 'kg/m2/s', & missing_value=missing_value ) id_m_cellup = register_diag_field ( mod_name, & 'm_cellup', axes(half), Time, & 'Upward Cell Mass Flux from donner', 'kg/m2/s', & missing_value=missing_value ) endif if (do_uw_conv) then id_tdt_uw = register_diag_field ( mod_name, & 'tdt_uw', axes(1:3), Time, & 'UW convection heating rate', 'deg K/s', & missing_value=missing_value ) id_qdt_uw = register_diag_field ( mod_name, & 'qdt_uw', axes(1:3), Time, & 'UW convection moistening rate', 'kg/kg/s', & missing_value=missing_value ) id_qadt_uw = register_diag_field ( mod_name, & 'qadt_uw', axes(1:3), Time, & 'UW convection cloud amount tendency', '1/s', & missing_value=missing_value ) id_qldt_uw = register_diag_field ( mod_name, & 'qldt_uw', axes(1:3), Time, & 'UW convection cloud liquid tendency', 'kg/kg/s', & missing_value=missing_value ) id_qidt_uw = register_diag_field ( mod_name, & 'qidt_uw', axes(1:3), Time, & 'UW convection ice water tendency', 'kg/kg/s', & missing_value=missing_value ) if (do_liq_num) & id_qndt_uw = register_diag_field ( mod_name, & 'qndt_uw', axes(1:3), Time, & 'UW convection cloud drop tendency', '#/kg/s', & missing_value=missing_value ) endif id_qvout = register_diag_field ( mod_name, & 'qvout', axes(1:3), Time, 'qv after strat_cloud', 'kg/kg', & missing_value=missing_value ) id_qaout = register_diag_field ( mod_name, & 'qaout', axes(1:3), Time, 'qa after strat_cloud', 'none', & missing_value=missing_value ) id_qlout = register_diag_field ( mod_name, & 'qlout', axes(1:3), Time, 'ql after strat_cloud', 'kg/kg', & missing_value=missing_value ) id_qiout = register_diag_field ( mod_name, & 'qiout', axes(1:3), Time, 'qi after strat_cloud', 'kg/kg', & missing_value=missing_value ) !--------------------------------------------------------------------- ! register diagnostics for lightning NOx !--------------------------------------------------------------------- if (get_tracer_index(MODEL_ATMOS,'no') > 0) & id_prod_no = register_diag_field ( 'tracers', & 'hook_no', axes(1:3), Time, & 'hook_no', 'molec/cm3/s') !----------------------------------------------------------------------- !--------------------------------------------------------------------- ! register the diagnostics associated with convective tracer ! transport. !--------------------------------------------------------------------- allocate (id_tracerdt_conv (num_tracers)) allocate (id_tracerdt_conv_col(num_tracers)) allocate (id_wet_deposition(num_tracers)) allocate (id_wetdep (num_tracers)) allocate (id_conv_tracer (num_tracers)) allocate (id_conv_tracer_col(num_tracers)) id_tracerdt_conv = -1 id_tracerdt_conv_col = -1 id_wet_deposition = -1 id_wetdep = -1 id_conv_tracer = -1 id_conv_tracer_col = -1 id_wetdep_om = & register_diag_field ( mod_name, & 'om_wet_dep', & axes(1:2), Time, & 'total om wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_SOA = & register_diag_field ( mod_name, & 'SOA_wet_dep', & axes(1:2), Time, & 'total SOA wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_bc = & register_diag_field ( mod_name, & 'bc_wet_dep', & axes(1:2), Time, & 'total bc wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_so4 = & register_diag_field ( mod_name, & 'so4_wet_dep', & axes(1:2), Time, & 'total so4 wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_so2 = & register_diag_field ( mod_name, & 'so2_wet_dep', & axes(1:2), Time, & 'total so2 wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_DMS = & register_diag_field ( mod_name, & 'DMS_wet_dep', & axes(1:2), Time, & 'total DMS wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_NH4NO3 = & register_diag_field ( mod_name, & 'totNH4_wet_dep', & axes(1:2), Time, & 'total NH4 + NH3 wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_salt = & register_diag_field ( mod_name, & 'ssalt_wet_dep', & axes(1:2), Time, & 'total seasalt wet deposition', & 'kg/m2/s', & missing_value=missing_value) id_wetdep_dust = & register_diag_field ( mod_name, & 'dust_wet_dep', & axes(1:2), Time, & 'total dust wet deposition', & 'kg/m2/s', & missing_value=missing_value) do n = 1,num_tracers call get_tracer_names (MODEL_ATMOS, n, name = tracer_name, & units = tracer_units) if (tracers_in_donner(n) .or. & tracers_in_ras(n) .or. & tracers_in_mca(n) .or. & tracers_in_uw(n)) then diaglname = trim(tracer_name)// & ' wet deposition from all precip' id_wetdep(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_wet_depo', & axes(1:2), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' total tendency from moist convection' id_tracerdt_conv(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'dt_conv', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' total path tendency from moist convection' id_tracerdt_conv_col(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'dt_conv_col', & axes(1:2), Time, trim(diaglname), & TRIM(tracer_units)//'*(kg/m2)/s', & missing_value=missing_value) endif diaglname = trim(tracer_name) id_conv_tracer(n) = & register_diag_field ( mod_name, & TRIM(tracer_name), & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units) , & missing_value=missing_value) diaglname = ' column integrated' // trim(tracer_name) id_conv_tracer_col(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_col', & axes(1:2), Time, trim(diaglname), & TRIM(tracer_units) , & missing_value=missing_value) id_wet_deposition(n) = register_diag_field( mod_name, & trim(tracer_name)//'_wetdep', axes(1:3), Time, & trim(tracer_name)//' tendency from wet deposition',TRIM(tracer_units)//'/sec', & missing_value=missing_value ) end do !------------------------------------------------------------------ ! register the variables associated with the mca component of ! donner_deep transport. !------------------------------------------------------------------ if (do_donner_deep) then allocate (id_tracerdt_mcadon (num_donner_tracers)) allocate (id_tracerdt_mcadon_col(num_donner_tracers)) nn = 1 do n = 1,num_tracers call get_tracer_names (MODEL_ATMOS, n, name = tracer_name, & units = tracer_units) if (tracers_in_donner(n) ) then diaglname = trim(tracer_name)// & ' tendency from donner-mca' id_tracerdt_mcadon(nn) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_donmca', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' total path tendency from donner-mca' id_tracerdt_mcadon_col(nn) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_donmca_col', & axes(1:2), Time, trim(diaglname), & TRIM(tracer_units)//'*(kg/m2)/s', & missing_value=missing_value) nn = nn + 1 endif end do endif end subroutine diag_field_init !####################################################################### function doing_strat() logical :: doing_strat if (.not. module_is_initialized) call error_mesg ('doing_strat', & 'moist_processes_init has not been called.', FATAL) doing_strat = do_strat end function doing_strat end module moist_processes_mod