From d2900143f7de8c3fe79e8135a0bab5f3267267b9 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 10 Jan 2023 15:31:25 -0700 Subject: [PATCH 001/122] add sfc_land and allow sbs along with fully coupled --- CODEOWNERS | 2 + physics/noahmpdrv.F90 | 12 ++- physics/noahmpdrv.meta | 14 ++++ physics/sfc_land.f | 146 ++++++++++++++++++++++++++++++++ physics/sfc_land.meta | 186 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 358 insertions(+), 2 deletions(-) create mode 100644 physics/sfc_land.f create mode 100644 physics/sfc_land.meta diff --git a/CODEOWNERS b/CODEOWNERS index cf7a886aa..19e0eb2a5 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -126,6 +126,8 @@ physics/h2ophys.* @AlexBelochitski-NOAA physics/sfc_sice.* @wd20xw @climbfuji @SamuelTrahanNOAA @grantfirl @mzhangw @panll @mkavulich @ChunxiZhang-NOAA physics/sfc_cice.* @wd20xw @climbfuji @SamuelTrahanNOAA @grantfirl @mzhangw @panll @mkavulich @ChunxiZhang-NOAA +physics/sfc_land.* @uturuncoglu @barlage + ######################################################################## # Lines starting with '#' are comments. diff --git a/physics/noahmpdrv.F90 b/physics/noahmpdrv.F90 index fed823ead..d15a9e82a 100644 --- a/physics/noahmpdrv.F90 +++ b/physics/noahmpdrv.F90 @@ -140,7 +140,7 @@ subroutine noahmpdrv_run & iopt_stc, iopt_trs,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -274,6 +274,9 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) + logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -601,7 +604,12 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 -do i = 1, im +! +! --- Just return if external land component is activated for two-way interaction +! + if (cpllnd .and. cpllnd2atm) return + + do i = 1, im if (flag_iter(i) .and. dry(i)) then diff --git a/physics/noahmpdrv.meta b/physics/noahmpdrv.meta index 3235b7c90..643987d98 100644 --- a/physics/noahmpdrv.meta +++ b/physics/noahmpdrv.meta @@ -611,6 +611,20 @@ dimensions = () type = logical intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land diff --git a/physics/sfc_land.f b/physics/sfc_land.f new file mode 100644 index 000000000..0c3130bbe --- /dev/null +++ b/physics/sfc_land.f @@ -0,0 +1,146 @@ +!> \file sfc_land.f +!! This file contains the code for coupling to land component + +!> This module contains the CCPP-compliant GFS land post +!! interstitial codes, which returns updated surface +!! properties such as latent heat and sensible heat +!! provided by the component version of land model + +!> This module contains the CCPP-compliant GFS land scheme. + module sfc_land + + contains + +!> \defgroup sfc_land for coupling to land +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_land_run Arguments +!! \htmlinclude sfc_land_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + +!! use physcons, only : hvap => con_hvap, cp => con_cp, & +!! & rvrdm1 => con_fvirt, rd => con_rd +! +!----------------------------------- + subroutine sfc_land_run & +! --- inputs: + & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & + & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & + & ep_lnd, t2mmp_lnd, q2mp_lnd, & +! --- outputs: + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + & errmsg, errflg, naux2d, aux2d + & ) + +! ===================================================================== ! +! description: ! +! Dec 2022 -- Ufuk Turuncoglu created for coupling to land ! +! ! +! usage: ! +! ! +! call sfc_land ! +! inputs: ! +! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! +! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! +! ep_lnd, t2mmp_lnd, q2mp_lnd, ! +! outputs: ! +! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! +! errmsg, errflg) ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: +! im - integer, horiz dimension +! cpllnd - logical, flag for land coupling +! cpllnd2atm - logical, flag for land coupling (lnd->atm) +! flag_iter - logical, flag for iteration +! dry - logical, eq T if a point with any land +! sncovr1_lnd - real , surface snow area fraction +! qsurf_lnd - real , specific humidity at sfc +! evap_lnd - real , evaporation from latent heat +! hflx_lnd - real , sensible heat +! ep_lnd - real , surface upward potential latent heat flux +! t2mmp_lnd - real , 2m temperature +! q2mp_lnd - real , 2m specific humidity +! outputs: +! sncovr1 - real , snow cover over land +! qsurf - real , specific humidity at sfc +! evap - real , evaporation from latent heat +! hflx - real , sensible heat +! ep - real , potential evaporation +! t2mmp - real , temperature at 2m +! q2mp - real , specific humidity at 2m +! ==================== end of description ===================== ! +! +! + use machine , only : kind_phys + implicit none + +! --- inputs: + integer, intent(in) :: im + logical, intent(in) :: cpllnd, cpllnd2atm + logical, dimension(:), intent(in) :: flag_iter + logical, dimension(:), intent(in) :: dry + + real (kind=kind_phys), dimension(:), intent(in) :: & + & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & + & t2mmp_lnd, q2mp_lnd + +! --- outputs: + real (kind=kind_phys), dimension(:), intent(out) :: & + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer, intent(in) :: naux2d + real(kind_phys), intent(out) :: aux2d(:,:) + +! --- locals: + + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (.not. cpllnd2atm) return +! + do i = 1, im + !if (flag_iter(i) .and. dry(i)) then + !if (dry(i)) then + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + !end if + enddo + + aux2d(:,1) = dry(:) !sncovr1(:) + aux2d(:,2) = qsurf(:) + aux2d(:,3) = hflx(:) + aux2d(:,4) = evap(:) + aux2d(:,5) = ep(:) + aux2d(:,6) = qsurf_lnd(:) !t2mmp(:) + aux2d(:,7) = q2mp(:) + + return +!----------------------------------- + end subroutine sfc_land_run +!----------------------------------- + +!> @} + end module sfc_land diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta new file mode 100644 index 000000000..f31d779ae --- /dev/null +++ b/physics/sfc_land.meta @@ -0,0 +1,186 @@ +[ccpp-table-properties] + name = sfc_land + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = sfc_land_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[sncovr1_lnd] + standard_name = surface_snow_area_fraction_over_land_from_land + long_name = surface snow area fraction over land for coupling + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[qsurf_lnd] + standard_name = surface_specific_humidity_over_land_from_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[evap_lnd] + standard_name = surface_upward_latent_heat_flux_over_land_from_land + long_name = sfc latent heat flux input over land for coupling + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[hflx_lnd] + standard_name = surface_upward_sensible_heat_flux_over_land_from_land + long_name = sfc sensible heat flux input over land for coupling + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ep_lnd] + standard_name = surface_upward_potential_latent_heat_flux_over_land_from_land + long_name = surface upward potential latent heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[t2mmp_lnd] + standard_name = temperature_at_2m_over_land_from_land + long_name = 2 meter temperature over land for coupling + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[q2mp_lnd] + standard_name = specific_humidity_at_2m_over_land_from_land + long_name = 2 meter specific humidity over land for coupling + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[naux2d] + standard_name = number_of_xy_dimensioned_auxiliary_arrays + long_name = number of 2d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer + intent = in +[aux2d] + standard_name = auxiliary_2d_arrays + long_name = auxiliary 2d arrays to output (for debugging) + units = none + dimensions = (horizontal_loop_extent,number_of_xy_dimensioned_auxiliary_arrays) + type = real + kind = kind_phys + intent = out From c18c6d49c635198cf4bd1b3cddf9c8d4848090d6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 30 Jan 2023 13:18:03 -0700 Subject: [PATCH 002/122] CCPP scheme simulator. --- physics/ccpp_scheme_simultator.F90 | 593 ++++++++++++++++++++++++++++ physics/ccpp_scheme_simultator.meta | 266 +++++++++++++ 2 files changed, 859 insertions(+) create mode 100644 physics/ccpp_scheme_simultator.F90 create mode 100644 physics/ccpp_scheme_simultator.meta diff --git a/physics/ccpp_scheme_simultator.F90 b/physics/ccpp_scheme_simultator.F90 new file mode 100644 index 000000000..4d53c8860 --- /dev/null +++ b/physics/ccpp_scheme_simultator.F90 @@ -0,0 +1,593 @@ +! ######################################################################################## +! +! CCPP scheme to replace physics schemes with simulated data tendencies. +! +! ######################################################################################## +module ccpp_scheme_simultator + use machine, only: kind_phys + use netcdf + implicit none + + ! + ! Data driven phsyics tendencies + ! + real(kind_phys), allocatable, dimension(:) :: time_data + real(kind_phys), allocatable, dimension(:,:) :: dTdt_LWRAD_data, dTdt_SWRAD_data, & + dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & + dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & + dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:) :: dqdt_PBL_data, dqdt_SCNV_data, & + dqdt_DCNV_data, dqdt_cldMP_data + + ! + ! Logical switches for CCPP scheme simulator(s) + ! + logical :: use_RAD_scheme_sim = .false., & + use_PBL_scheme_sim = .false., & + use_GWD_scheme_sim = .false., & + use_SCNV_scheme_sim = .false., & + use_DCNV_scheme_sim = .false., & + use_cldMP_scheme_sim = .false. + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + logical :: do_ccpp_scheme_simulator = .false. + + ! Host-model initial time information + integer :: init_year, init_month, init_day, init_hour, init_min, init_sec + + public ccpp_scheme_simultator_init, ccpp_scheme_simultator_run +contains + + ! ###################################################################################### + ! + ! SUBROUTINE ccpp_scheme_simultator_init + ! + ! ###################################################################################### +!! \section arg_table_ccpp_scheme_simultator_init +!! \htmlinclude ccpp_scheme_simultator_init.html +!! + subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + + ! Inputs + integer, intent (in) :: me, master, nlunit + character(len=*), intent (in) :: nml_file + integer, intent (in), dimension(8) :: idat + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, nlev, ntime, ios + character(len=256) :: fileIN + logical :: exists + integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + + ! Namelist + namelist / scm_data_nml / & + fileIN, use_RAD_scheme_sim, use_PBL_scheme_sim, use_GWD_scheme_sim, use_SCNV_scheme_sim, & + use_DCNV_scheme_sim, use_cldMP_scheme_sim + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Store model initialization time. + init_year = idat(1) + init_month = idat(2) + init_day = idat(3) + init_hour = idat(5) + init_min = idat(6) + init_sec = idat(7) + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = scm_data_nml) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & + use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then + do_ccpp_scheme_simulator = .true. + else + return + endif + + ! Check that input data file exists + inquire (file = trim (fileIN), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain time dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain lev dimension' + errflg = 1 + return + endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + allocate(time_data(ntime)) + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + allocate(dTdt_LWRAD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + have_dTdt_LWRAD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + allocate(dTdt_SWRAD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + have_dTdt_SWRAD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dTdt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_PBL_data) + have_dTdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dqdt_PBL_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_PBL_data) + have_dqdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dudt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_PBL_data) + have_dudt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dvdt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_PBL_data) + have_dvdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dTdt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_GWD_data) + have_dTdt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dudt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_GWD_data) + have_dudt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dvdt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_GWD_data) + have_dvdt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dTdt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + have_dTdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dudt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_SCNV_data) + have_dudt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dvdt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + have_dvdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dqdt_SCNV_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + have_dqdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dTdt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + have_dTdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dudt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_DCNV_data) + have_dudt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dvdt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + have_dvdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dqdt_DCNV_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + have_dqdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + allocate(dTdt_cldMP_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + have_dTdt_cldMP_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + allocate(dqdt_cldMP_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + have_dqdt_cldMP_data = .true. + endif + + ! + if (me == 0) then + print*, "--- Using SCM data tendencies ---" + print*, "---------------------------------" + print*, " " + print*, "use_RAD_scheme_sim: ", use_RAD_scheme_sim + print*, " dTdt_LWRAD_data: ", have_dTdt_LWRAD_data + print*, " dTdt_SWRAD_data: ", have_dTdt_SWRAD_data + print*, "use_PBL_scheme_sim: ", use_PBL_scheme_sim + print*, " dTdt_PBL_data: ", have_dTdt_PBL_data + print*, " dqdt_PBL_data: ", have_dqdt_PBL_data + print*, " dudt_PBL_data: ", have_dudt_PBL_data + print*, " dvdt_PBL_data: ", have_dvdt_PBL_data + print*, "use_GWD_scheme_sim: ", use_GWD_scheme_sim + print*, " dTdt_gwd_data: ", have_dTdt_GWD_data + print*, " dudt_gwd_data: ", have_dudt_GWD_data + print*, " dvdt_gwd_data: ", have_dvdt_GWD_data + print*, "use_SCNV_scheme_sim: ", use_SCNV_scheme_sim + print*, " dTdt_SCNV_data: ", have_dTdt_SCNV_data + print*, " dudt_SCNV_data: ", have_dudt_SCNV_data + print*, " dvdt_SCNV_data: ", have_dvdt_SCNV_data + print*, " dqdt_SCNV_data: ", have_dqdt_SCNV_data + print*, "use_DCNV_scheme_sim: ", use_DCNV_scheme_sim + print*, " dTdt_DCNV_data: ", have_dTdt_DCNV_data + print*, " dudt_DCNV_data: ", have_dudt_DCNV_data + print*, " dvdt_DCNV_data: ", have_dvdt_DCNV_data + print*, " dqdt_DCNV_data: ", have_dqdt_DCNV_data + print*, "use_cldMP_scheme_sim: ", use_cldMP_scheme_sim + print*, " dTdt_cldMP_data: ", have_dTdt_cldMP_data + print*, " dqdt_cldMP_data: ", have_dqdt_cldMP_data + print*, "---------------------------------" + endif + + end subroutine ccpp_scheme_simultator_init + + ! ###################################################################################### + ! + ! SUBROUTINE ccpp_scheme_simultator_run + ! + ! ###################################################################################### +!! \section arg_table_ccpp_scheme_simultator_run +!! \htmlinclude ccpp_scheme_simultator_run.html +!! + subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + dtend, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & + errmsg, errflg) + + ! Inputs + integer, intent(in ) :: kdt + integer, intent (in), dimension(8) :: jdat + real(kind_phys), intent(in ) :: dtp, solhr + real(kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, dtend + integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv + + ! Outputs + real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 + character(len=*),intent(out ) :: errmsg + integer, intent(out ) :: errflg + + ! Locals + integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec + real(kind_phys) :: w1, w2,hrofday + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1 + real(kind_phys), dimension(:,:,:), allocatable :: gq1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_scheme_simulator) return + + ! Current forecast time + fcst_year = jdat(1) + fcst_month = jdat(2) + fcst_day = jdat(3) + fcst_hour = jdat(5) + fcst_min = jdat(6) + fcst_sec = jdat(7) + + ! Dimensions + nCol = size(gq0(:,1,1)) + nLay = size(gq0(1,:,1)) + nTrc = size(gq0(1,1,:)) + + ! Allocate temporaries + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + + ! Determine temporal interpolation weights for data-tendecies. + ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, + ! which is needed for reasonable solar forcing. + hrofday = fcst_hour*3600. + fcst_min*60. + fcst_sec + ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) + if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w2 = 1 - w1 + + do iCol = 1,nCol + ! Set state + gt1(iCol,:) = tgrs(iCol,:) + gu1(iCol,:) = ugrs(iCol,:) + gv1(iCol,:) = vgrs(iCol,:) + gq1(iCol,:,1) = qgrs(iCol,:,1) + + ! ############################################################################### + ! Radiation + ! ############################################################################### + if (use_RAD_scheme_sim) then + if (have_dTdt_LWRAD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_LWRAD_data(:,ti(1)) + w2*dTdt_LWRAD_data(:,tf(1))) * dtp + endif + if (have_dTdt_SWRAD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SWRAD_data(:,ti(1)) + w2*dTdt_SWRAD_data(:,tf(1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if (idtend >=1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! PBL + ! ############################################################################### + if (use_PBL_scheme_sim) then + if (have_dTdt_PBL_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_PBL_data(:,ti(1)) + w2*(dTdt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dudt_PBL_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_PBL_data(:,ti(1)) + w2*(dudt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dvdt_PBL_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_PBL_data(:,ti(1)) + w2*(dvdt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dqdt_PBL_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_PBL_data(:,ti(1),1) + w2*(dqdt_PBL_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_pbl) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_pbl) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv, index_of_process_pbl) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Gravity wave drag + ! ############################################################################### + if (use_GWD_scheme_sim) then + if (have_dTdt_GWD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_GWD_data(:,ti(1)) + w2*(dTdt_GWD_data(:,tf(1)))) * dtp + endif + if (have_dudt_GWD_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_GWD_data(:,ti(1)) + w2*(dudt_GWD_data(:,tf(1)))) * dtp + endif + if (have_dvdt_GWD_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_GWD_data(:,ti(1)) + w2*(dvdt_GWD_data(:,tf(1)))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Shallow convection + ! ############################################################################### + if (use_SCNV_scheme_sim) then + if (have_dTdt_SCNV_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SCNV_data(:,ti(1)) + w2*(dTdt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dudt_SCNV_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_SCNV_data(:,ti(1)) + w2*(dudt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dvdt_SCNV_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_SCNV_data(:,ti(1)) + w2*(dvdt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dqdt_SCNV_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_SCNV_data(:,ti(1),1) + w2*(dqdt_SCNV_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_scnv) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_scnv) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_scnv) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_scnv) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Deep convection + ! ############################################################################### + if (use_DCNV_scheme_sim) then + if (have_dTdt_DCNV_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_DCNV_data(:,ti(1)) + w2*(dTdt_DCNV_data(:,tf(1)) )) * dtp + endif + if (have_dudt_DCNV_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_DCNV_data(:,ti(1)) + w2*(dudt_DCNV_data(:,tf(1)))) * dtp + endif + if (have_dvdt_DCNV_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_DCNV_data(:,ti(1)) + w2*(dvdt_DCNV_data(:,tf(1)) )) * dtp + endif + if (have_dqdt_DCNV_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_DCNV_data(:,ti(1),1) + w2*(dqdt_DCNV_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_dcnv) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_dcnv) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_dcnv) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_dcnv) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Cloud microphysics + ! ############################################################################### + if (use_cldMP_scheme_sim) then + if (have_dTdt_cldMP_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_cldMP_data(:,ti(1)) + w2*(dTdt_cldMP_data(:,tf(1)))) * dtp + endif + if (have_dqdt_cldMP_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_cldMP_data(:,ti(1),1) + w2*(dqdt_cldMP_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_mp) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_mp) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + enddo ! columns + ! + end subroutine ccpp_scheme_simultator_run + +end module ccpp_scheme_simultator diff --git a/physics/ccpp_scheme_simultator.meta b/physics/ccpp_scheme_simultator.meta new file mode 100644 index 000000000..e60248721 --- /dev/null +++ b/physics/ccpp_scheme_simultator.meta @@ -0,0 +1,266 @@ +[ccpp-table-properties] + name = ccpp_scheme_simultator + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = ccpp_scheme_simultator_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in +[nml_file] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[idat] + standard_name = date_and_time_at_model_initialization_in_iso_order + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = ccpp_scheme_simultator_run + type = scheme +[solhr] + standard_name = forecast_utc_hour + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[jdat] + standard_name = date_and_time_of_forecast_in_united_states_order + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[gt0] + standard_name = air_temperature_of_new_state + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gu0] + standard_name = x_wind_of_new_state + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind_of_new_state + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file From f9abb735c0741eff2b79420f49082a5300fe46c9 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 30 Jan 2023 13:26:48 -0700 Subject: [PATCH 003/122] Fix file rename typo --- ...multator.F90 => ccpp_scheme_simulator.F90} | 26 +++++++++---------- ...ltator.meta => ccpp_scheme_simulator.meta} | 6 ++--- 2 files changed, 16 insertions(+), 16 deletions(-) rename physics/{ccpp_scheme_simultator.F90 => ccpp_scheme_simulator.F90} (96%) rename physics/{ccpp_scheme_simultator.meta => ccpp_scheme_simulator.meta} (98%) diff --git a/physics/ccpp_scheme_simultator.F90 b/physics/ccpp_scheme_simulator.F90 similarity index 96% rename from physics/ccpp_scheme_simultator.F90 rename to physics/ccpp_scheme_simulator.F90 index 4d53c8860..2954e3759 100644 --- a/physics/ccpp_scheme_simultator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -3,7 +3,7 @@ ! CCPP scheme to replace physics schemes with simulated data tendencies. ! ! ######################################################################################## -module ccpp_scheme_simultator +module ccpp_scheme_ccpp_scheme_simulator use machine, only: kind_phys use netcdf implicit none @@ -52,18 +52,18 @@ module ccpp_scheme_simultator ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec - public ccpp_scheme_simultator_init, ccpp_scheme_simultator_run + public ccpp_scheme_ccpp_scheme_simulator_init, ccpp_scheme_ccpp_scheme_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simultator_init + ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_init ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simultator_init -!! \htmlinclude ccpp_scheme_simultator_init.html +!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_init +!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) ! Inputs integer, intent (in) :: me, master, nlunit @@ -331,17 +331,17 @@ subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errms print*, "---------------------------------" endif - end subroutine ccpp_scheme_simultator_init + end subroutine ccpp_scheme_ccpp_scheme_simulator_init ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simultator_run + ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simultator_run -!! \htmlinclude ccpp_scheme_simultator_run.html +!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_run +!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -588,6 +588,6 @@ subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, q enddo ! columns ! - end subroutine ccpp_scheme_simultator_run + end subroutine ccpp_scheme_ccpp_scheme_simulator_run -end module ccpp_scheme_simultator +end module ccpp_scheme_ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simultator.meta b/physics/ccpp_scheme_simulator.meta similarity index 98% rename from physics/ccpp_scheme_simultator.meta rename to physics/ccpp_scheme_simulator.meta index e60248721..cad1bd7ed 100644 --- a/physics/ccpp_scheme_simultator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = ccpp_scheme_simultator + name = ccpp_scheme_ccpp_scheme_simulator type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_simultator_init + name = ccpp_scheme_ccpp_scheme_simulator_init type = scheme [me] standard_name = mpi_rank @@ -61,7 +61,7 @@ ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_simultator_run + name = ccpp_scheme_ccpp_scheme_simulator_run type = scheme [solhr] standard_name = forecast_utc_hour From ef0d369f607aa78908ac1a3687236ee7468f0fc6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 31 Jan 2023 15:02:09 -0700 Subject: [PATCH 004/122] Added MPI commands to ccpp_scheme_simulator --- physics/ccpp_scheme_simulator.F90 | 534 ++++++++++++++++++++--------- physics/ccpp_scheme_simulator.meta | 17 +- 2 files changed, 382 insertions(+), 169 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 2954e3759..8289db769 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -3,9 +3,13 @@ ! CCPP scheme to replace physics schemes with simulated data tendencies. ! ! ######################################################################################## -module ccpp_scheme_ccpp_scheme_simulator +module ccpp_scheme_simulator use machine, only: kind_phys use netcdf +#ifdef MPI + use mpi +#endif + implicit none ! @@ -52,21 +56,21 @@ module ccpp_scheme_ccpp_scheme_simulator ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec - public ccpp_scheme_ccpp_scheme_simulator_init, ccpp_scheme_ccpp_scheme_simulator_run + public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_init + ! SUBROUTINE ccpp_scheme_simulator_init ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_init -!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_init.html +!! \section arg_table_ccpp_scheme_simulator_init +!! \htmlinclude ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, idat, errmsg, errflg) ! Inputs - integer, intent (in) :: me, master, nlunit + integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit character(len=*), intent (in) :: nml_file integer, intent (in), dimension(8) :: idat @@ -75,7 +79,7 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, nlev, ntime, ios + integer :: ncid, dimID, varID, status, nlon, nlat, nlev_data, ntime_data, ios character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality @@ -97,7 +101,11 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, init_min = idat(6) init_sec = idat(7) + ! ###################################################################################### + ! ! Read in namelist + ! + ! ###################################################################################### inquire (file = trim (nml_file), exist = exists) if (.not. exists) then errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' @@ -110,6 +118,12 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, read (nlunit, nml = scm_data_nml) close (nlunit) + + ! ###################################################################################### + ! + ! Error checking + ! + ! ###################################################################################### ! Only proceed if scheme simulator requested. if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then @@ -126,180 +140,372 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, return endif - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif + ! ####################################################################################### + ! + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain time dimension' - errflg = 1 - return - endif + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain lev dimension' - errflg = 1 - return - endif + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! #################################################################################### + ! + ! What data fields do we have? + ! + ! #################################################################################### + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status /= nf90_noerr) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - allocate(time_data(ntime)) - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif + ! Physics tendencies + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + have_dTdt_LWRAD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + have_dTdt_SWRAD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + have_dTdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + have_dqdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + have_dudt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + have_dvdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dTdt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dudt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dvdt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dTdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dudt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dvdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dqdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dTdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dudt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dvdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dqdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + have_dTdt_cldMP_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + have_dqdt_cldMP_data = .true. + endif - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - allocate(dTdt_LWRAD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - have_dTdt_LWRAD_data = .true. - endif +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + + ! ####################################################################################### ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - allocate(dTdt_SWRAD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - have_dTdt_SWRAD_data = .true. - endif + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dTdt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_PBL_data) - have_dTdt_PBL_data = .true. - endif + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + endif + ! + status = nf90_close(ncid) +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + ! ####################################################################################### ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dqdt_PBL_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_PBL_data) - have_dqdt_PBL_data = .true. - endif + ! Broadcast data... + ! (ALL processors) ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dudt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_PBL_data) - have_dudt_PBL_data = .true. + ! ####################################################################################### + + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dvdt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_PBL_data) - have_dvdt_PBL_data = .true. + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dTdt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_GWD_data) - have_dTdt_GWD_data = .true. + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dudt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_GWD_data) - have_dudt_GWD_data = .true. + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dvdt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_GWD_data) - have_dvdt_GWD_data = .true. + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dTdt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - have_dTdt_SCNV_data = .true. + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dudt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_SCNV_data) - have_dudt_SCNV_data = .true. + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dvdt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - have_dvdt_SCNV_data = .true. + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dqdt_SCNV_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - have_dqdt_SCNV_data = .true. + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dTdt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - have_dTdt_DCNV_data = .true. + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dudt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_DCNV_data) - have_dudt_DCNV_data = .true. + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dvdt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - have_dvdt_DCNV_data = .true. + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dqdt_DCNV_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - have_dqdt_DCNV_data = .true. + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - allocate(dTdt_cldMP_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - have_dTdt_cldMP_data = .true. + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - allocate(dqdt_cldMP_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - have_dqdt_cldMP_data = .true. + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + + ! + call mpi_barrier(mpicomm, mpierr) +#endif ! - if (me == 0) then + if (mpirank .eq. mpiroot) then print*, "--- Using SCM data tendencies ---" print*, "---------------------------------" print*, " " @@ -331,17 +537,17 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, print*, "---------------------------------" endif - end subroutine ccpp_scheme_ccpp_scheme_simulator_init + end subroutine ccpp_scheme_simulator_init ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_run + ! SUBROUTINE ccpp_scheme_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_run -!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_run.html +!! \section arg_table_ccpp_scheme_simulator_run +!! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -588,6 +794,6 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ug enddo ! columns ! - end subroutine ccpp_scheme_ccpp_scheme_simulator_run + end subroutine ccpp_scheme_simulator_run -end module ccpp_scheme_ccpp_scheme_simulator +end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index cad1bd7ed..909089bb9 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,26 +1,33 @@ [ccpp-table-properties] - name = ccpp_scheme_ccpp_scheme_simulator + name = ccpp_scheme_simulator type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_ccpp_scheme_simulator_init + name = ccpp_scheme_simulator_init type = scheme -[me] +[mpirank] standard_name = mpi_rank long_name = MPI rank of current process units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = MPI rank of master process units = index dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in [nlunit] standard_name = iounit_of_namelist long_name = fortran unit number for opening nameliust file @@ -61,7 +68,7 @@ ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_ccpp_scheme_simulator_run + name = ccpp_scheme_simulator_run type = scheme [solhr] standard_name = forecast_utc_hour From fd72b355bc99486bda0aff5d5a1c78f835756938 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 3 Feb 2023 10:27:05 -0700 Subject: [PATCH 005/122] Work in progress... --- physics/ccpp_scheme_simulator.F90 | 821 +++++++++++++++-------------- physics/ccpp_scheme_simulator.meta | 8 - 2 files changed, 416 insertions(+), 413 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 8289db769..258687416 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -2,6 +2,8 @@ ! ! CCPP scheme to replace physics schemes with simulated data tendencies. ! +! Description: +! ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys @@ -9,50 +11,118 @@ module ccpp_scheme_simulator #ifdef MPI use mpi #endif - implicit none + ! Avaialble physics processes to simulate. + integer,parameter :: & + nPhysProcess = 7 + + ! Type containing physics tendencies for a physics process. + type phys_tend + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q + end type phys_tend + + ! This type contains the meta information and data for each physics process. + type base_physics_process + character(len=16) :: name + logical :: time_split + logical :: use_sim + integer :: order + type(phys_tend) :: tend + end type base_physics_process + + ! This array contains the governing information on how to advance the physics timestep. + type(base_physics_process),dimension(nPhysProcess) :: & + physics_process + + ! ######################################################################################## + ! + ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to + ! populate "physics_processes" type array. + ! + ! ######################################################################################## + + ! Set which schemes to be replaced with simulated tendencies. + logical :: use_LWRAD_scheme_sim = .false., & !< If true, use LongWave RADiation scheme simulator. + !< If false, use tendencies from radiation scheme. + use_SWRAD_scheme_sim = .false., & !< If true, use ShortWave RADiation scheme simulator. + !< If false, use tendencies from radiation scheme. + use_PBL_scheme_sim = .false., & !< If true, use Planetary Boubdary Layer scheme simulator. + !< If false, use tendencies from PBL scheme. + use_GWD_scheme_sim = .false., & !< If true, use Gravity Wave Drag scheme simulator. + !< If false, use tendencies from GWD scheme. + use_SCNV_scheme_sim = .false., & !< If true, use Shallow CoNVection scheme simulator. + !< If false, use tendencies from SCNV scheme. + use_DCNV_scheme_sim = .false., & !< If true, use Deep CoNVection scheme simulator. + !< If false, use tendencies from DCNV scheme. + use_cldMP_scheme_sim = .false. !< If true, use cloud MicroPhysics scheme simulator. + !< If false, use tendencies from cldMP acheme. + + ! Are the processes time-split or process-split? + logical :: time_split_LWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_SWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_PBL = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_GWD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_SCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_DCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_cldMP = .true. !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + + ! What is physics process ordering? (Important if their are time-split processes in the physics scheme) + integer :: scheme_order_SWRAD = 1, & !< Order of Radiation scheme (shortwave). + scheme_order_LWRAD = 2, & !< Order of Radiation scheme (longwave). + scheme_order_PBL = 3, & !< Order of Planetary Boubdary Layer scheme. + scheme_order_GWD = 4, & !< Order of Gravity Wave Drag scheme. + scheme_order_SCNV = 5, & !< Order of Shallow CoNVection scheme. + scheme_order_DCNV = 6, & !< Order of Deep CoNVection scheme. + scheme_order_cldMP = 7 !< Order of cloud MicroPhysics scheme. ! - ! Data driven phsyics tendencies + ! Locals ! + + ! Activation flag for scheme. + logical :: do_ccpp_scheme_simulator = .false. + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & !< If true, input file contains LongWave RADiation temperature tendencies. + have_dTdt_SWRAD_data = .false., & !< If true, input file contains ShortWave RADiation temperature tendencies. + have_dTdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer temperature tendencies. + have_dqdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer specific-humidity tendencies. + have_dudt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer zonal-wind tendencies. + have_dvdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer meridional-wind tendencies. + have_dTdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag temperature tendencies. + have_dudt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag zonal-wind tendencies. + have_dvdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag meridional-wind tendencies. + have_dTdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection temperature tendencies. + have_dudt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection zonal-wind tendencies. + have_dvdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection meridional-wind tendencies. + have_dqdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection specific-humidity tendencies. + have_dTdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection temperature tendencies. + have_dudt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection zonal-wind tendencies. + have_dvdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection meridional-wind tendencies. + have_dqdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection specific-humidity tendencies. + have_dTdt_cldMP_data = .false., & !< If true, input file contains cloud MicroPhysics temperature tendencies. + have_dqdt_cldMP_data = .false. !< If true, input file contains cloud MicroPhysics specific-humidity tendencies. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data - real(kind_phys), allocatable, dimension(:,:) :: dTdt_LWRAD_data, dTdt_SWRAD_data, & + real(kind_phys), allocatable, dimension(:,:),target :: dTdt_LWRAD_data, dTdt_SWRAD_data, & dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:) :: dqdt_PBL_data, dqdt_SCNV_data, & + real(kind_phys), allocatable, dimension(:,:,:),target :: dqdt_PBL_data, dqdt_SCNV_data, & dqdt_DCNV_data, dqdt_cldMP_data - ! - ! Logical switches for CCPP scheme simulator(s) - ! - logical :: use_RAD_scheme_sim = .false., & - use_PBL_scheme_sim = .false., & - use_GWD_scheme_sim = .false., & - use_SCNV_scheme_sim = .false., & - use_DCNV_scheme_sim = .false., & - use_cldMP_scheme_sim = .false. - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - logical :: do_ccpp_scheme_simulator = .false. - ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec @@ -67,7 +137,8 @@ module ccpp_scheme_simulator !! \section arg_table_ccpp_scheme_simulator_init !! \htmlinclude ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & + idat, errmsg, errflg) ! Inputs integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit @@ -79,15 +150,19 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, nlev_data, ntime_data, ios + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality ! Namelist - namelist / scm_data_nml / & - fileIN, use_RAD_scheme_sim, use_PBL_scheme_sim, use_GWD_scheme_sim, use_SCNV_scheme_sim, & - use_DCNV_scheme_sim, use_cldMP_scheme_sim + namelist / scm_data_nml / fileIN, & + use_SWRAD_scheme_sim, use_LWRAD_scheme_sim, use_PBL_scheme_sim, & + use_GWD_scheme_sim, use_SCNV_scheme_sim, use_DCNV_scheme_sim, & + use_cldMP_scheme_sim, scheme_order_SWRAD, scheme_order_LWRAD, scheme_order_PBL, & + scheme_order_GWD, scheme_order_SCNV, scheme_order_DCNV, scheme_order_cldMP, & + time_split_SWRAD, time_split_LWRAD, time_split_PBL, time_split_GWD, & + time_split_SCNV, time_split_DCNV, time_split_cldMP ! Initialize CCPP error handling variables errmsg = '' @@ -118,27 +193,27 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil read (nlunit, nml = scm_data_nml) close (nlunit) - ! ###################################################################################### ! ! Error checking ! ! ###################################################################################### ! Only proceed if scheme simulator requested. - if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & - use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then + if (use_SWRAD_scheme_sim .or. use_LWRAD_scheme_sim .or. use_PBL_scheme_sim .or. & + use_GWD_scheme_sim .or. use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. & + use_cldMP_scheme_sim) then do_ccpp_scheme_simulator = .true. else return endif - + ! Check that input data file exists inquire (file = trim (fileIN), exist = exists) if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif ! ####################################################################################### ! @@ -201,91 +276,63 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! #################################################################################### - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status /= nf90_noerr) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Physics tendencies + ! status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - have_dTdt_LWRAD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - have_dTdt_SWRAD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - have_dTdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - have_dqdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - have_dudt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - have_dvdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dTdt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dudt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dvdt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dTdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dudt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dvdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dqdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dTdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dudt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dvdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dqdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - have_dTdt_cldMP_data = .true. - endif + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - have_dqdt_cldMP_data = .true. - endif + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. #ifdef MPI endif ! Master process @@ -335,101 +382,64 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! Read in physics data tendencies (optional) status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) ! status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) ! status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) ! status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) ! status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) ! status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) ! status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) ! status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) ! status = nf90_close(ncid) + #ifdef MPI endif ! Master process @@ -449,49 +459,49 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_cldMP_data) then call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) @@ -499,41 +509,94 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil if (have_dqdt_cldMP_data) then call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! call mpi_barrier(mpicomm, mpierr) #endif + ! ####################################################################################### + ! + ! Populate physics_process type. + ! + ! ####################################################################################### + + ! Metadata + do iprc = 1,nPhysProcess + if (iprc == scheme_order_SWRAD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + physics_process(iprc)%use_sim = use_SWRAD_scheme_sim + physics_process(iprc)%time_split = time_split_SWRAD + endif + if (iprc == scheme_order_LWRAD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + physics_process(iprc)%use_sim = use_LWRAD_scheme_sim + physics_process(iprc)%time_split = time_split_LWRAD + endif + if (iprc == scheme_order_GWD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + physics_process(iprc)%use_sim = use_GWD_scheme_sim + physics_process(iprc)%time_split = time_split_GWD + endif + if (iprc == scheme_order_PBL) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + physics_process(iprc)%use_sim = use_PBL_scheme_sim + physics_process(iprc)%time_split = time_split_PBL + endif + if (iprc == scheme_order_SCNV) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + physics_process(iprc)%use_sim = use_SCNV_scheme_sim + physics_process(iprc)%time_split = time_split_SCNV + endif + if (iprc == scheme_order_DCNV) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + physics_process(iprc)%use_sim = use_DCNV_scheme_sim + physics_process(iprc)%time_split = time_split_DCNV + endif + if (iprc == scheme_order_cldMP) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + physics_process(iprc)%use_sim = use_cldMP_scheme_sim + physics_process(iprc)%time_split = time_split_cldMP + endif + enddo + + ! Data + if (have_dTdt_LWRAD_data) physics_process(scheme_order_LWRAD)%tend%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(scheme_order_SWRAD)%tend%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(scheme_order_PBL)%tend%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(scheme_order_PBL)%tend%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(scheme_order_PBL)%tend%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(scheme_order_PBL)%tend%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(scheme_order_GWD)%tend%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(scheme_order_GWD)%tend%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(scheme_order_GWD)%tend%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(scheme_order_SCNV)%tend%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(scheme_order_DCNV)%tend%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%q => dqdt_cldMP_data + ! if (mpirank .eq. mpiroot) then - print*, "--- Using SCM data tendencies ---" + print*, "--- Using CCPP data tendencies ---" print*, "---------------------------------" print*, " " - print*, "use_RAD_scheme_sim: ", use_RAD_scheme_sim - print*, " dTdt_LWRAD_data: ", have_dTdt_LWRAD_data - print*, " dTdt_SWRAD_data: ", have_dTdt_SWRAD_data - print*, "use_PBL_scheme_sim: ", use_PBL_scheme_sim - print*, " dTdt_PBL_data: ", have_dTdt_PBL_data - print*, " dqdt_PBL_data: ", have_dqdt_PBL_data - print*, " dudt_PBL_data: ", have_dudt_PBL_data - print*, " dvdt_PBL_data: ", have_dvdt_PBL_data - print*, "use_GWD_scheme_sim: ", use_GWD_scheme_sim - print*, " dTdt_gwd_data: ", have_dTdt_GWD_data - print*, " dudt_gwd_data: ", have_dudt_GWD_data - print*, " dvdt_gwd_data: ", have_dvdt_GWD_data - print*, "use_SCNV_scheme_sim: ", use_SCNV_scheme_sim - print*, " dTdt_SCNV_data: ", have_dTdt_SCNV_data - print*, " dudt_SCNV_data: ", have_dudt_SCNV_data - print*, " dvdt_SCNV_data: ", have_dvdt_SCNV_data - print*, " dqdt_SCNV_data: ", have_dqdt_SCNV_data - print*, "use_DCNV_scheme_sim: ", use_DCNV_scheme_sim - print*, " dTdt_DCNV_data: ", have_dTdt_DCNV_data - print*, " dudt_DCNV_data: ", have_dudt_DCNV_data - print*, " dvdt_DCNV_data: ", have_dvdt_DCNV_data - print*, " dqdt_DCNV_data: ", have_dqdt_DCNV_data - print*, "use_cldMP_scheme_sim: ", use_cldMP_scheme_sim - print*, " dTdt_cldMP_data: ", have_dTdt_cldMP_data - print*, " dqdt_cldMP_data: ", have_dqdt_cldMP_data + do iprc = 1,nPhysProcess + print*,"Process : ", trim(physics_process(iprc)%name) + print*," order : ", physics_process(iprc)%order + print*," use_sim : ", physics_process(iprc)%use_sim + print*," time_split : ", physics_process(iprc)%time_split + enddo print*, "---------------------------------" endif @@ -547,7 +610,7 @@ end subroutine ccpp_scheme_simulator_init !! \section arg_table_ccpp_scheme_simulator_run !! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -555,28 +618,29 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg errmsg, errflg) ! Inputs - integer, intent(in ) :: kdt - integer, intent (in), dimension(8) :: jdat - real(kind_phys), intent(in ) :: dtp, solhr - real(kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, dtend - integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & + integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(8) :: jdat + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind_phys), intent(in), dimension(:,:,:) :: qgrs, dtend ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 - character(len=*),intent(out ) :: errmsg - integer, intent(out ) :: errflg + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg ! Locals integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1 - real(kind_phys), dimension(:,:,:), allocatable :: gq1 + real(kind_phys), dimension(:), allocatable :: dT, du, dv, dq + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt + real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' @@ -596,9 +660,11 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg nCol = size(gq0(:,1,1)) nLay = size(gq0(1,:,1)) nTrc = size(gq0(1,1,:)) - + ! Allocate temporaries allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) + allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) ! Determine temporal interpolation weights for data-tendecies. ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, @@ -610,190 +676,135 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) w2 = 1 - w1 - do iCol = 1,nCol - ! Set state - gt1(iCol,:) = tgrs(iCol,:) - gu1(iCol,:) = ugrs(iCol,:) - gv1(iCol,:) = vgrs(iCol,:) - gq1(iCol,:,1) = qgrs(iCol,:,1) - - ! ############################################################################### - ! Radiation - ! ############################################################################### - if (use_RAD_scheme_sim) then - if (have_dTdt_LWRAD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_LWRAD_data(:,ti(1)) + w2*dTdt_LWRAD_data(:,tf(1))) * dtp - endif - if (have_dTdt_SWRAD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SWRAD_data(:,ti(1)) + w2*dTdt_SWRAD_data(:,tf(1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_longwave) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_temperature,index_of_process_shortwave) - if (idtend >=1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! + ! DJS BEGIN: This section will, eventually, replace the icol loop below, using the physics_process type. + ! - ! ############################################################################### - ! PBL - ! ############################################################################### - if (use_PBL_scheme_sim) then - if (have_dTdt_PBL_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_PBL_data(:,ti(1)) + w2*(dTdt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dudt_PBL_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_PBL_data(:,ti(1)) + w2*(dudt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dvdt_PBL_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_PBL_data(:,ti(1)) + w2*(dvdt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dqdt_PBL_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_PBL_data(:,ti(1),1) + w2*(dqdt_PBL_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_pbl) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_pbl) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_pbl) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv, index_of_process_pbl) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + ! Set state + gt1(:,:) = tgrs(:,:) + gu1(:,:) = ugrs(:,:) + gv1(:,:) = vgrs(:,:) + gq1(:,:,1) = qgrs(:,:,1) + dTdt(:,:) = 0. + dudt(:,:) = 0. + dvdt(:,:) = 0. + dqdt(:,:,1)= 0. + do iCol = 1,nCol + do iprc = 1,nPhysProcess + + ! Using scheme simulator + if (physics_process(iprc)%use_sim) then + print*,"Using CCPP scheme simulator for ",trim(physics_process(iprc)%name) + + ! Temperature + if (associated(physics_process(iprc)%tend%T)) then + call interp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + endif + + ! Zonal-wind + if (associated(physics_process(iprc)%tend%u)) then + call interp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + endif + + ! Meridional-wind + if (associated(physics_process(iprc)%tend%v)) then + call interp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + endif + + ! Specific-humidity + if (associated(physics_process(iprc)%tend%q)) then + call interp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + endif + + ! Using data tendency from "active" scheme(s). + else + print*,"ACTIVE PHYSICS SCHEME: ",trim(physics_process(iprc)%name) + if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave + if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave + if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl + if (physics_process(iprc)%name == "GWD") index_of_process = index_of_process_orographic_gwd + if (physics_process(iprc)%name == "SCNV") index_of_process = index_of_process_scnv + if (physics_process(iprc)%name == "DCNV") index_of_process = index_of_process_dcnv + if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp + ! + idtend = dtidx(index_of_temperature,index_of_process) + if (idtend >= 1) dT = dtend(iCol,:,idtend) + ! + idtend = dtidx(index_of_x_wind,index_of_process) + if (idtend >= 1) du = dtend(iCol,:,idtend) + ! + idtend = dtidx(index_of_y_wind,index_of_process) + if (idtend >= 1) dv = dtend(iCol,:,idtend) + ! + idtend = dtidx(100+ntqv,index_of_process) + if (idtend >= 1) dq = dtend(iCol,:,idtend) endif - endif + + ! Update state now? + if (physics_process(iprc)%time_split) then + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + du)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + dv)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + dq)*dtp + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:,1) = 0. + ! Accumulate tendencies, update later? + else + dTdt(iCol,:) = dTdt(iCol,:) + dT + dudt(iCol,:) = dudt(iCol,:) + du + dvdt(iCol,:) = dvdt(iCol,:) + dv + dqdt(iCol,:,1) = dqdt(iCol,:,1) + dq + endif + enddo + ! + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp + enddo + ! + end subroutine ccpp_scheme_simulator_run - ! ############################################################################### - ! Gravity wave drag - ! ############################################################################### - if (use_GWD_scheme_sim) then - if (have_dTdt_GWD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_GWD_data(:,ti(1)) + w2*(dTdt_GWD_data(:,tf(1)))) * dtp - endif - if (have_dudt_GWD_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_GWD_data(:,ti(1)) + w2*(dudt_GWD_data(:,tf(1)))) * dtp - endif - if (have_dvdt_GWD_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_GWD_data(:,ti(1)) + w2*(dvdt_GWD_data(:,tf(1)))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! #################################################################################### + ! Utility functions/routines + ! #################################################################################### + subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour, minute, & + second, var_out) + ! Inputs + character(len=*), intent(in) :: var_name, process_name + integer, intent(in) :: year, month, day, hour, minute, second, iprc + + ! Outputs + real(kind_phys),dimension(:),intent(out) :: var_out - ! ############################################################################### - ! Shallow convection - ! ############################################################################### - if (use_SCNV_scheme_sim) then - if (have_dTdt_SCNV_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SCNV_data(:,ti(1)) + w2*(dTdt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dudt_SCNV_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_SCNV_data(:,ti(1)) + w2*(dudt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dvdt_SCNV_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_SCNV_data(:,ti(1)) + w2*(dvdt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dqdt_SCNV_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_SCNV_data(:,ti(1),1) + w2*(dqdt_SCNV_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_scnv) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_scnv) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_scnv) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_scnv) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! Locals + integer :: ti(1), tf(1) + real(kind_phys) :: w1, w2, hrofday - ! ############################################################################### - ! Deep convection - ! ############################################################################### - if (use_DCNV_scheme_sim) then - if (have_dTdt_DCNV_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_DCNV_data(:,ti(1)) + w2*(dTdt_DCNV_data(:,tf(1)) )) * dtp - endif - if (have_dudt_DCNV_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_DCNV_data(:,ti(1)) + w2*(dudt_DCNV_data(:,tf(1)))) * dtp - endif - if (have_dvdt_DCNV_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_DCNV_data(:,ti(1)) + w2*(dvdt_DCNV_data(:,tf(1)) )) * dtp - endif - if (have_dqdt_DCNV_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_DCNV_data(:,ti(1),1) + w2*(dqdt_DCNV_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_dcnv) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_dcnv) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_dcnv) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_dcnv) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + hrofday = hour*3600. + minute*60. + second + ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) + if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w2 = 1 - w1 - ! ############################################################################### - ! Cloud microphysics - ! ############################################################################### - if (use_cldMP_scheme_sim) then - if (have_dTdt_cldMP_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_cldMP_data(:,ti(1)) + w2*(dTdt_cldMP_data(:,tf(1)))) * dtp - endif - if (have_dqdt_cldMP_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_cldMP_data(:,ti(1),1) + w2*(dqdt_cldMP_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_mp) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_mp) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + if (var_name == "T") then + var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) + endif - enddo ! columns - ! - end subroutine ccpp_scheme_simulator_run + if (var_name == "u") then + var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) + endif + + if (var_name == "v") then + var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) + endif + + if (var_name == "q") then + var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + endif + end subroutine interp_data_tend end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 909089bb9..92e39ff61 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -70,14 +70,6 @@ [ccpp-arg-table] name = ccpp_scheme_simulator_run type = scheme -[solhr] - standard_name = forecast_utc_hour - long_name = time in hours after 00z at the current timestep - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration From ffd26ab39759091969c23995dfc051c077b330c6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 6 Feb 2023 10:55:30 -0700 Subject: [PATCH 006/122] Some changes --- physics/ccpp_scheme_simulator.F90 | 42 +++++++++++++++---------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 258687416..be7ad03f9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -666,20 +666,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) - ! Determine temporal interpolation weights for data-tendecies. - ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, - ! which is needed for reasonable solar forcing. - hrofday = fcst_hour*3600. + fcst_min*60. + fcst_sec - ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) - if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) - w2 = 1 - w1 - - ! - ! DJS BEGIN: This section will, eventually, replace the icol loop below, using the physics_process type. - ! - ! Set state gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) @@ -689,8 +675,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(:,:) = 0. dvdt(:,:) = 0. dqdt(:,:,1)= 0. - do iCol = 1,nCol - do iprc = 1,nPhysProcess + do iprc = 1,nPhysProcess + do iCol = 1,nCol + ! + dT = 0. + du = 0. + dv = 0. + dq = 0. ! Using scheme simulator if (physics_process(iprc)%use_sim) then @@ -728,18 +719,18 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp ! idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) dT = dtend(iCol,:,idtend) + if (idtend >= 1) dT = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) du = dtend(iCol,:,idtend) + if (idtend >= 1) du = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) dv = dtend(iCol,:,idtend) + if (idtend >= 1) dv = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) dq = dtend(iCol,:,idtend) + if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp endif - + ! Update state now? if (physics_process(iprc)%time_split) then gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp @@ -750,7 +741,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. - ! Accumulate tendencies, update later? + ! Accumulate tendencies, update later? else dTdt(iCol,:) = dTdt(iCol,:) + dT dudt(iCol,:) = dudt(iCol,:) + du @@ -765,6 +756,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp enddo ! + + do iCol=1,size(gq0(:,1,1)) + do iLay=1,size(gq0(1,:,1)) + write(*,'(i5,4f8.3)') iLay,tgrs(iCol,iLay),gt0(iCol,iLay),gt1(iCol,iLay),gt0(iCol,iLay)-gt1(iCol,iLay) + enddo + enddo + end subroutine ccpp_scheme_simulator_run ! #################################################################################### From 112ac895f62c3d4034dac67ec73b0d126b78098f Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 7 Feb 2023 12:36:11 -0700 Subject: [PATCH 007/122] Some small cleanup --- physics/ccpp_scheme_simulator.F90 | 103 +++++++++++------------------ physics/ccpp_scheme_simulator.meta | 7 -- 2 files changed, 39 insertions(+), 71 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index be7ad03f9..b3075e36a 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -116,15 +116,12 @@ module ccpp_scheme_simulator ! Data driven physics tendencies integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data - real(kind_phys), allocatable, dimension(:,:),target :: dTdt_LWRAD_data, dTdt_SWRAD_data, & - dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & - dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & - dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:),target :: dqdt_PBL_data, dqdt_SCNV_data, & - dqdt_DCNV_data, dqdt_cldMP_data - - ! Host-model initial time information - integer :: init_year, init_month, init_day, init_hour, init_min, init_sec + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains @@ -138,12 +135,11 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_init.html !! subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - idat, errmsg, errflg) + errmsg, errflg) ! Inputs integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit character(len=*), intent (in) :: nml_file - integer, intent (in), dimension(8) :: idat ! Outputs character(len=*), intent(out) :: errmsg @@ -168,14 +164,6 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil errmsg = '' errflg = 0 - ! Store model initialization time. - init_year = idat(1) - init_month = idat(2) - init_day = idat(3) - init_hour = idat(5) - init_min = idat(6) - init_sec = idat(7) - ! ###################################################################################### ! ! Read in namelist @@ -592,10 +580,12 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil print*, "---------------------------------" print*, " " do iprc = 1,nPhysProcess - print*,"Process : ", trim(physics_process(iprc)%name) - print*," order : ", physics_process(iprc)%order - print*," use_sim : ", physics_process(iprc)%use_sim - print*," time_split : ", physics_process(iprc)%time_split + if (physics_process(iprc)%use_sim) then + print*,"Process : ", trim(physics_process(iprc)%name) + print*," order : ", physics_process(iprc)%order + print*," use_sim : ", physics_process(iprc)%use_sim + print*," time_split : ", physics_process(iprc)%time_split + endif enddo print*, "---------------------------------" endif @@ -662,7 +652,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti nTrc = size(gq0(1,1,:)) ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) @@ -675,6 +665,8 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(:,:) = 0. dvdt(:,:) = 0. dqdt(:,:,1)= 0. + + ! Model internal physics timestep evolution of "state". do iprc = 1,nPhysProcess do iCol = 1,nCol ! @@ -685,31 +677,21 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Using scheme simulator if (physics_process(iprc)%use_sim) then - print*,"Using CCPP scheme simulator for ",trim(physics_process(iprc)%name) - - ! Temperature if (associated(physics_process(iprc)%tend%T)) then - call interp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) endif - - ! Zonal-wind if (associated(physics_process(iprc)%tend%u)) then - call interp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + call linterp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) endif - - ! Meridional-wind if (associated(physics_process(iprc)%tend%v)) then - call interp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + call linterp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) endif - - ! Specific-humidity if (associated(physics_process(iprc)%tend%q)) then - call interp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + call linterp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) endif ! Using data tendency from "active" scheme(s). else - print*,"ACTIVE PHYSICS SCHEME: ",trim(physics_process(iprc)%name) if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl @@ -730,7 +712,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti idtend = dtidx(100+ntqv,index_of_process) if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp endif - + ! Update state now? if (physics_process(iprc)%time_split) then gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp @@ -754,22 +736,17 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp - enddo - ! - do iCol=1,size(gq0(:,1,1)) - do iLay=1,size(gq0(1,:,1)) - write(*,'(i5,4f8.3)') iLay,tgrs(iCol,iLay),gt0(iCol,iLay),gt1(iCol,iLay),gt0(iCol,iLay)-gt1(iCol,iLay) - enddo enddo - + ! end subroutine ccpp_scheme_simulator_run ! #################################################################################### ! Utility functions/routines ! #################################################################################### - subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour, minute, & - second, var_out) + ! The routine interpolates the data-tendencies + subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & + minute, second, var_out) ! Inputs character(len=*), intent(in) :: var_name, process_name integer, intent(in) :: year, month, day, hour, minute, second, iprc @@ -781,6 +758,7 @@ subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour integer :: ti(1), tf(1) real(kind_phys) :: w1, w2, hrofday + ! Linear interpolation weights hrofday = hour*3600. + minute*60. + second ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 @@ -788,21 +766,18 @@ subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) w2 = 1 - w1 - if (var_name == "T") then - var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) - endif - - if (var_name == "u") then - var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) - endif - - if (var_name == "v") then - var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) - endif - - if (var_name == "q") then - var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) - endif - end subroutine interp_data_tend + ! + select case(var_name) + case("T") + var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) + case("u") + var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) + case("v") + var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) + case("q") + var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + end select + + end subroutine linterp_data_tend end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 92e39ff61..80f898ed2 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -43,13 +43,6 @@ type = character kind = len=* intent = in -[idat] - standard_name = date_and_time_at_model_initialization_in_iso_order - long_name = initialization date and time - units = none - dimensions = (8) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 7e2954615d03ee085c2cbc91d6326ee2ecac88cb Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Feb 2023 15:12:09 -0700 Subject: [PATCH 008/122] update sfc_land --- physics/sfc_land.f | 39 +++++++++++++++++++++------------------ physics/sfc_land.meta | 16 ++++++++++++++++ 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 0c3130bbe..ab0691251 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -36,9 +36,10 @@ subroutine sfc_land_run & ! --- inputs: & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & - & ep_lnd, t2mmp_lnd, q2mp_lnd, & + & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + & gflux, & & errmsg, errflg, naux2d, aux2d & ) @@ -52,9 +53,10 @@ subroutine sfc_land_run & ! inputs: ! ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! -! ep_lnd, t2mmp_lnd, q2mp_lnd, ! +! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! +! gflux, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -71,7 +73,8 @@ subroutine sfc_land_run & ! hflx_lnd - real , sensible heat ! ep_lnd - real , surface upward potential latent heat flux ! t2mmp_lnd - real , 2m temperature -! q2mp_lnd - real , 2m specific humidity +! q2mp_lnd - real , 2m specific humidity +! gflux_lnd - real , soil heat flux over land ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -79,7 +82,8 @@ subroutine sfc_land_run & ! hflx - real , sensible heat ! ep - real , potential evaporation ! t2mmp - real , temperature at 2m -! q2mp - real , specific humidity at 2m +! q2mp - real , specific humidity at 2m +! gflux - real , soil heat flux over land ! ==================== end of description ===================== ! ! ! @@ -94,11 +98,11 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -117,25 +121,24 @@ subroutine sfc_land_run & if (.not. cpllnd2atm) return ! do i = 1, im - !if (flag_iter(i) .and. dry(i)) then - !if (dry(i)) then - sncovr1(i) = sncovr1_lnd(i) - qsurf(i) = qsurf_lnd(i) - hflx(i) = hflx_lnd(i) - evap(i) = evap_lnd(i) - ep(i) = ep_lnd(i) - t2mmp(i) = t2mmp_lnd(i) - q2mp(i) = q2mp_lnd(i) - !end if + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) enddo - aux2d(:,1) = dry(:) !sncovr1(:) + aux2d(:,1) = sncovr1(:) aux2d(:,2) = qsurf(:) aux2d(:,3) = hflx(:) aux2d(:,4) = evap(:) aux2d(:,5) = ep(:) - aux2d(:,6) = qsurf_lnd(:) !t2mmp(:) + aux2d(:,6) = t2mmp(:) aux2d(:,7) = q2mp(:) + aux2d(:,8) = gflux(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index f31d779ae..50ddecd46 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -98,6 +98,14 @@ type = real kind = kind_phys intent = in +[gflux_lnd] + standard_name = upward_heat_flux_in_soil_over_land_from_land + long_name = soil heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -154,6 +162,14 @@ type = real kind = kind_phys intent = out +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6a4c4b17c94130955de38b5dff5fc7e284d77dce Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 9 Feb 2023 15:04:23 -0700 Subject: [PATCH 009/122] More OO changes. Will split into load_data and ccpp_scheme components soon. --- physics/ccpp_scheme_simulator.F90 | 274 ++++++++++++++++-------------- 1 file changed, 143 insertions(+), 131 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index b3075e36a..3c82fe094 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -13,10 +13,6 @@ module ccpp_scheme_simulator #endif implicit none - ! Avaialble physics processes to simulate. - integer,parameter :: & - nPhysProcess = 7 - ! Type containing physics tendencies for a physics process. type phys_tend real(kind_phys), dimension(:,:), pointer :: T @@ -28,16 +24,18 @@ module ccpp_scheme_simulator ! This type contains the meta information and data for each physics process. type base_physics_process character(len=16) :: name - logical :: time_split - logical :: use_sim + logical :: time_split = .false. + logical :: use_sim = .false. integer :: order type(phys_tend) :: tend end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process),dimension(nPhysProcess) :: & + type(base_physics_process),dimension(:), allocatable :: & physics_process + integer :: nPhysProcess + ! ######################################################################################## ! ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to @@ -45,74 +43,20 @@ module ccpp_scheme_simulator ! ! ######################################################################################## - ! Set which schemes to be replaced with simulated tendencies. - logical :: use_LWRAD_scheme_sim = .false., & !< If true, use LongWave RADiation scheme simulator. - !< If false, use tendencies from radiation scheme. - use_SWRAD_scheme_sim = .false., & !< If true, use ShortWave RADiation scheme simulator. - !< If false, use tendencies from radiation scheme. - use_PBL_scheme_sim = .false., & !< If true, use Planetary Boubdary Layer scheme simulator. - !< If false, use tendencies from PBL scheme. - use_GWD_scheme_sim = .false., & !< If true, use Gravity Wave Drag scheme simulator. - !< If false, use tendencies from GWD scheme. - use_SCNV_scheme_sim = .false., & !< If true, use Shallow CoNVection scheme simulator. - !< If false, use tendencies from SCNV scheme. - use_DCNV_scheme_sim = .false., & !< If true, use Deep CoNVection scheme simulator. - !< If false, use tendencies from DCNV scheme. - use_cldMP_scheme_sim = .false. !< If true, use cloud MicroPhysics scheme simulator. - !< If false, use tendencies from cldMP acheme. - - ! Are the processes time-split or process-split? - logical :: time_split_LWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_SWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_PBL = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_GWD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_SCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_DCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_cldMP = .true. !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - - ! What is physics process ordering? (Important if their are time-split processes in the physics scheme) - integer :: scheme_order_SWRAD = 1, & !< Order of Radiation scheme (shortwave). - scheme_order_LWRAD = 2, & !< Order of Radiation scheme (longwave). - scheme_order_PBL = 3, & !< Order of Planetary Boubdary Layer scheme. - scheme_order_GWD = 4, & !< Order of Gravity Wave Drag scheme. - scheme_order_SCNV = 5, & !< Order of Shallow CoNVection scheme. - scheme_order_DCNV = 6, & !< Order of Deep CoNVection scheme. - scheme_order_cldMP = 7 !< Order of cloud MicroPhysics scheme. - ! - ! Locals - ! + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + proc_LWRAD_config = (/0,0,0/), & + proc_SWRAD_config = (/0,0,0/), & + proc_PBL_config = (/0,0,0/), & + proc_GWD_config = (/0,0,0/), & + proc_SCNV_config = (/0,0,0/), & + proc_DCNV_config = (/0,0,0/), & + proc_cldMP_config = (/0,0,0/) ! Activation flag for scheme. logical :: do_ccpp_scheme_simulator = .false. - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & !< If true, input file contains LongWave RADiation temperature tendencies. - have_dTdt_SWRAD_data = .false., & !< If true, input file contains ShortWave RADiation temperature tendencies. - have_dTdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer temperature tendencies. - have_dqdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer specific-humidity tendencies. - have_dudt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer zonal-wind tendencies. - have_dvdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer meridional-wind tendencies. - have_dTdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag temperature tendencies. - have_dudt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag zonal-wind tendencies. - have_dvdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag meridional-wind tendencies. - have_dTdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection temperature tendencies. - have_dudt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection zonal-wind tendencies. - have_dvdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection meridional-wind tendencies. - have_dqdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection specific-humidity tendencies. - have_dTdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection temperature tendencies. - have_dudt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection zonal-wind tendencies. - have_dvdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection meridional-wind tendencies. - have_dqdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection specific-humidity tendencies. - have_dTdt_cldMP_data = .false., & !< If true, input file contains cloud MicroPhysics temperature tendencies. - have_dqdt_cldMP_data = .false. !< If true, input file contains cloud MicroPhysics specific-humidity tendencies. - ! Data driven physics tendencies integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data @@ -123,6 +67,12 @@ module ccpp_scheme_simulator real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + ! Scheme initialization flag. + logical :: module_initialized = .false. + + ! Order in process loop for "active" physics process. + integer :: iactive_scheme + public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains @@ -151,19 +101,39 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + ! Namelist - namelist / scm_data_nml / fileIN, & - use_SWRAD_scheme_sim, use_LWRAD_scheme_sim, use_PBL_scheme_sim, & - use_GWD_scheme_sim, use_SCNV_scheme_sim, use_DCNV_scheme_sim, & - use_cldMP_scheme_sim, scheme_order_SWRAD, scheme_order_LWRAD, scheme_order_PBL, & - scheme_order_GWD, scheme_order_SCNV, scheme_order_DCNV, scheme_order_cldMP, & - time_split_SWRAD, time_split_LWRAD, time_split_PBL, time_split_GWD, & - time_split_SCNV, time_split_DCNV, time_split_cldMP + namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & + proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & + proc_cldMP_config ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (module_initialized) return + module_initialized = .true. + ! ###################################################################################### ! ! Read in namelist @@ -187,9 +157,9 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! ###################################################################################### ! Only proceed if scheme simulator requested. - if (use_SWRAD_scheme_sim .or. use_LWRAD_scheme_sim .or. use_PBL_scheme_sim .or. & - use_GWD_scheme_sim .or. use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. & - use_cldMP_scheme_sim) then + if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & + proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & + proc_cldMP_config(1)) then do_ccpp_scheme_simulator = .true. else return @@ -507,87 +477,128 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! ####################################################################################### + ! Allocate + allocate(physics_process(nPhysProcess)) + ! Metadata do iprc = 1,nPhysProcess - if (iprc == scheme_order_SWRAD) then + if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" - physics_process(iprc)%use_sim = use_SWRAD_scheme_sim - physics_process(iprc)%time_split = time_split_SWRAD + if (proc_SWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_LWRAD) then + if (iprc == proc_LWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "LWRAD" - physics_process(iprc)%use_sim = use_LWRAD_scheme_sim - physics_process(iprc)%time_split = time_split_LWRAD + if (proc_LWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_LWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_GWD) then + if (iprc == proc_GWD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "GWD" - physics_process(iprc)%use_sim = use_GWD_scheme_sim - physics_process(iprc)%time_split = time_split_GWD + if (proc_GWD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_GWD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_PBL) then + if (iprc == proc_PBL_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "PBL" - physics_process(iprc)%use_sim = use_PBL_scheme_sim - physics_process(iprc)%time_split = time_split_PBL + if (proc_PBL_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_PBL_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_SCNV) then + if (iprc == proc_SCNV_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SCNV" - physics_process(iprc)%use_sim = use_SCNV_scheme_sim - physics_process(iprc)%time_split = time_split_SCNV + if (proc_SCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_DCNV) then + if (iprc == proc_DCNV_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "DCNV" - physics_process(iprc)%use_sim = use_DCNV_scheme_sim - physics_process(iprc)%time_split = time_split_DCNV + if (proc_DCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_DCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_cldMP) then + if (iprc == proc_cldMP_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "cldMP" - physics_process(iprc)%use_sim = use_cldMP_scheme_sim - physics_process(iprc)%time_split = time_split_cldMP + if (proc_cldMP_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_cldMP_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif enddo - ! Data - if (have_dTdt_LWRAD_data) physics_process(scheme_order_LWRAD)%tend%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(scheme_order_SWRAD)%tend%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(scheme_order_PBL)%tend%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(scheme_order_PBL)%tend%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(scheme_order_PBL)%tend%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(scheme_order_PBL)%tend%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(scheme_order_GWD)%tend%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(scheme_order_GWD)%tend%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(scheme_order_GWD)%tend%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(scheme_order_SCNV)%tend%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(scheme_order_DCNV)%tend%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%q => dqdt_cldMP_data + ! Load data + if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%q => dqdt_cldMP_data + + ! Which process-scheme is "Active"? + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) then + iactive_scheme = iprc + endif + enddo ! if (mpirank .eq. mpiroot) then + print*, "----------------------------------" print*, "--- Using CCPP data tendencies ---" - print*, "---------------------------------" - print*, " " + print*, "----------------------------------" do iprc = 1,nPhysProcess if (physics_process(iprc)%use_sim) then - print*,"Process : ", trim(physics_process(iprc)%name) - print*," order : ", physics_process(iprc)%order - print*," use_sim : ", physics_process(iprc)%use_sim - print*," time_split : ", physics_process(iprc)%time_split + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split endif enddo - print*, "---------------------------------" + print*, " active_scheme: ", trim(physics_process(iactive_scheme)%name) + print*, " order: ", physics_process(iactive_scheme)%order + print*, " time_split : ", physics_process(iactive_scheme)%time_split + print*, "----------------------------------" + print*, "----------------------------------" endif end subroutine ccpp_scheme_simulator_init @@ -675,7 +686,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dv = 0. dq = 0. - ! Using scheme simulator + ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then if (associated(physics_process(iprc)%tend%T)) then call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) @@ -691,6 +702,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti endif ! Using data tendency from "active" scheme(s). + ! DJS2023: This block is very ufs specific. Need to tidy this up. else if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave @@ -745,7 +757,7 @@ end subroutine ccpp_scheme_simulator_run ! Utility functions/routines ! #################################################################################### ! The routine interpolates the data-tendencies - subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & + subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & minute, second, var_out) ! Inputs character(len=*), intent(in) :: var_name, process_name From be4cc2e5acb11c99794d465496503833a4842a45 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 9 Feb 2023 19:25:45 -0700 Subject: [PATCH 010/122] More OO changes --- physics/ccpp_scheme_simulator.F90 | 134 +++++++++++++++++------------- 1 file changed, 75 insertions(+), 59 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 3c82fe094..f8f040be2 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -13,27 +13,41 @@ module ccpp_scheme_simulator #endif implicit none - ! Type containing physics tendencies for a physics process. - type phys_tend + ! Type containing 1D (instantaneous) physics tendencies + type tend_inst + real(kind_phys), dimension(:), pointer :: dT + real(kind_phys), dimension(:), pointer :: du + real(kind_phys), dimension(:), pointer :: dv + real(kind_phys), dimension(:), pointer :: dq + end type tend_inst + + ! Type containing 2D data physics tendencies. + type phys_tend_2d + real(kind_phys), dimension(:), pointer :: time real(kind_phys), dimension(:,:), pointer :: T real(kind_phys), dimension(:,:), pointer :: u real(kind_phys), dimension(:,:), pointer :: v real(kind_phys), dimension(:,:,:), pointer :: q - end type phys_tend + end type phys_tend_2d ! This type contains the meta information and data for each physics process. type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend) :: tend + character(len=16) :: name + logical :: time_split = .false. + logical :: use_sim = .false. + integer :: order + type(phys_tend_2d) :: tend + type(tend_inst) :: itend + contains + generic, public :: linterp => linterp_1D + procedure, private :: linterp_1D end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. type(base_physics_process),dimension(:), allocatable :: & physics_process + ! Number of physics process (set in namelist) integer :: nPhysProcess ! ######################################################################################## @@ -59,7 +73,7 @@ module ccpp_scheme_simulator ! Data driven physics tendencies integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:) :: time_data + real(kind_phys), allocatable, dimension(:), target :: time_data real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & @@ -482,6 +496,10 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! Metadata do iprc = 1,nPhysProcess + allocate(physics_process(iprc)%itend%dT(nlev_data)) + allocate(physics_process(iprc)%itend%du(nlev_data)) + allocate(physics_process(iprc)%itend%dv(nlev_data)) + allocate(physics_process(iprc)%itend%dq(nlev_data)) if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" @@ -555,6 +573,13 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil enddo ! Load data + physics_process(proc_LWRAD_config(3))%tend%time => time_data + physics_process(proc_SWRAD_config(3))%tend%time => time_data + physics_process(proc_PBL_config(3))%tend%time => time_data + physics_process(proc_GWD_config(3))%tend%time => time_data + physics_process(proc_DCNV_config(3))%tend%time => time_data + physics_process(proc_SCNV_config(3))%tend%time => time_data + physics_process(proc_cldMP_config(3))%tend%time => time_data if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data @@ -639,7 +664,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:), allocatable :: dT, du, dv, dq real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt @@ -649,7 +673,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (.not. do_ccpp_scheme_simulator) return - ! Current forecast time + ! Current forecast time (Data-format specific) fcst_year = jdat(1) fcst_month = jdat(2) fcst_day = jdat(3) @@ -665,7 +689,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Allocate temporaries allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) - allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) ! Set state gt1(:,:) = tgrs(:,:) @@ -680,25 +703,25 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Model internal physics timestep evolution of "state". do iprc = 1,nPhysProcess do iCol = 1,nCol - ! - dT = 0. - du = 0. - dv = 0. - dq = 0. + ! Reset locals + physics_process(iprc)%itend%dT(:) = 0. + physics_process(iprc)%itend%du(:) = 0. + physics_process(iprc)%itend%dv(:) = 0. + physics_process(iprc)%itend%dq(:) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then if (associated(physics_process(iprc)%tend%T)) then - call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%u)) then - call linterp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%v)) then - call linterp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%q)) then - call linterp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif ! Using data tendency from "active" scheme(s). @@ -713,34 +736,34 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp ! idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) dT = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dT = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) du = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%du = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) dv = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dv = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dq = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + du)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + dv)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + dq)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%itend%dT)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%itend%du)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%itend%dv)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%itend%dq)*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + dT - dudt(iCol,:) = dudt(iCol,:) + du - dvdt(iCol,:) = dvdt(iCol,:) + dv - dqdt(iCol,:,1) = dqdt(iCol,:,1) + dq + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%itend%dT + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%itend%du + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%itend%dv + dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%itend%dq endif enddo ! @@ -756,40 +779,33 @@ end subroutine ccpp_scheme_simulator_run ! #################################################################################### ! Utility functions/routines ! #################################################################################### - ! The routine interpolates the data-tendencies - subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & - minute, second, var_out) - ! Inputs - character(len=*), intent(in) :: var_name, process_name - integer, intent(in) :: year, month, day, hour, minute, second, iprc - - ! Outputs - real(kind_phys),dimension(:),intent(out) :: var_out - - ! Locals + function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, minute, second + character(len=128) :: err_message integer :: ti(1), tf(1) real(kind_phys) :: w1, w2, hrofday - ! Linear interpolation weights + ! Interpolation weights hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) - if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + ti = findloc(abs(this%tend%time-hrofday),minval(abs(this%tend%time-hrofday))) + if (hrofday - this%tend%time(ti(1)) .le. 0) ti = ti-1 tf = ti + 1 - w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w1 = (this%tend%time(tf(1))-hrofday) / (this%tend%time(tf(1)) - this%tend%time(ti(1))) w2 = 1 - w1 - ! select case(var_name) - case("T") - var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) - case("u") - var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) - case("v") - var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) - case("q") - var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + case("T") + this%itend%dT = w1*this%tend%T(:,ti(1)) + w2*this%tend%T(:,tf(1)) + case("u") + this%itend%du = w1*this%tend%u(:,ti(1)) + w2*this%tend%u(:,tf(1)) + case("v") + this%itend%dv = w1*this%tend%v(:,ti(1)) + w2*this%tend%v(:,tf(1)) + case("q") + this%itend%dq = w1*this%tend%q(:,ti(1),1) + w2*this%tend%q(:,tf(1),1) end select - end subroutine linterp_data_tend - + end function linterp_1D + end module ccpp_scheme_simulator From 7001ef9134859977e1c92c2d1b4f54a1c697183c Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 09:50:59 -0700 Subject: [PATCH 011/122] Split scheme into load and simulator components. --- physics/ccpp_scheme_simulator.F90 | 837 +++++++---------------------- physics/ccpp_scheme_simulator.meta | 56 -- physics/load_ccpp_scheme_sim.F90 | 577 ++++++++++++++++++++ physics/load_ccpp_scheme_sim.meta | 60 +++ 4 files changed, 830 insertions(+), 700 deletions(-) create mode 100644 physics/load_ccpp_scheme_sim.F90 create mode 100644 physics/load_ccpp_scheme_sim.meta diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index f8f040be2..3b478844f 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,21 +7,21 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - use netcdf -#ifdef MPI - use mpi -#endif - implicit none - ! Type containing 1D (instantaneous) physics tendencies - type tend_inst - real(kind_phys), dimension(:), pointer :: dT - real(kind_phys), dimension(:), pointer :: du - real(kind_phys), dimension(:), pointer :: dv - real(kind_phys), dimension(:), pointer :: dq - end type tend_inst + implicit none - ! Type containing 2D data physics tendencies. + ! ######################################################################################## + ! Types used by the scheme simulator + ! ######################################################################################## + ! Type containing 1D (time) physics tendencies. + type phys_tend_1d + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q + end type phys_tend_1d + + ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d real(kind_phys), dimension(:), pointer :: time real(kind_phys), dimension(:,:), pointer :: T @@ -30,603 +30,65 @@ module ccpp_scheme_simulator real(kind_phys), dimension(:,:,:), pointer :: q end type phys_tend_2d + ! Type containing 3D (loc,lev,time) physics tendencies. + type phys_tend_3d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q + end type phys_tend_3d + + ! Type containing 4D (lon, lat,lev,time) physics tendencies. + type phys_tend_4d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:,:), pointer :: q + end type phys_tend_4d + ! This type contains the meta information and data for each physics process. type base_physics_process character(len=16) :: name logical :: time_split = .false. logical :: use_sim = .false. integer :: order - type(phys_tend_2d) :: tend - type(tend_inst) :: itend + type(phys_tend_1d) :: tend1d + type(phys_tend_2d) :: tend2d + type(phys_tend_3d) :: tend3d + type(phys_tend_4d) :: tend4d contains - generic, public :: linterp => linterp_1D + generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D + procedure, private :: linterp_2D + procedure, public :: find_nearest_loc_2d_1d + procedure, public :: cmp_time_wts end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process),dimension(:), allocatable :: & + type(base_physics_process), dimension(:), allocatable :: & physics_process - ! Number of physics process (set in namelist) - integer :: nPhysProcess - - ! ######################################################################################## - ! - ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to - ! populate "physics_processes" type array. - ! - ! ######################################################################################## - - ! For each process there is a corresponding namelist entry, which is constructed as follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - proc_LWRAD_config = (/0,0,0/), & - proc_SWRAD_config = (/0,0,0/), & - proc_PBL_config = (/0,0,0/), & - proc_GWD_config = (/0,0,0/), & - proc_SCNV_config = (/0,0,0/), & - proc_DCNV_config = (/0,0,0/), & - proc_cldMP_config = (/0,0,0/) - - ! Activation flag for scheme. - logical :: do_ccpp_scheme_simulator = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data - - ! Scheme initialization flag. - logical :: module_initialized = .false. - - ! Order in process loop for "active" physics process. + ! For time-split physics process we need to call this scheme twice in the SDF, once + ! before the "active" scheme is called, and once after. This is because the active + ! scheme uses an internal physics state that has been advanced forward by a subsequent + ! physics process(es). + character(len=16) :: active_name integer :: iactive_scheme + integer :: proc_start, proc_end + logical :: active_time_split_process=.false. - public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run -contains - - ! ###################################################################################### - ! - ! SUBROUTINE ccpp_scheme_simulator_init - ! - ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simulator_init -!! \htmlinclude ccpp_scheme_simulator_init.html -!! - subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - errmsg, errflg) - - ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc - character(len=256) :: fileIN - logical :: exists - integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Namelist - namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & - proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & - proc_cldMP_config - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (module_initialized) return - module_initialized = .true. - - ! ###################################################################################### - ! - ! Read in namelist - ! - ! ###################################################################################### - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = scm_data_nml) - close (nlunit) - - ! ###################################################################################### - ! - ! Error checking - ! - ! ###################################################################################### - ! Only proceed if scheme simulator requested. - if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & - proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & - proc_cldMP_config(1)) then - do_ccpp_scheme_simulator = .true. - else - return - endif - - ! Check that input data file exists - inquire (file = trim (fileIN), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif - - ! ####################################################################################### - ! - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) - ! - ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! ####################################################################################### - ! - ! Broadcast dimensions... - ! (ALL processors) - ! - ! ####################################################################################### - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! #################################################################################### - ! - ! What data fields do we have? - ! - ! #################################################################################### - - ! - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) - - ! ####################################################################################### - ! - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) - ! - ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) + ! Set to true in data was loaded into "physics_process" + logical :: do_ccpp_scheme_simulator=.false. -#ifdef MPI - endif ! Master process + public ccpp_scheme_simulator_run - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - ! ####################################################################################### - ! - ! Broadcast data... - ! (ALL processors) - ! - ! ####################################################################################### - - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Populate physics_process type. - ! - ! ####################################################################################### - - ! Allocate - allocate(physics_process(nPhysProcess)) - - ! Metadata - do iprc = 1,nPhysProcess - allocate(physics_process(iprc)%itend%dT(nlev_data)) - allocate(physics_process(iprc)%itend%du(nlev_data)) - allocate(physics_process(iprc)%itend%dv(nlev_data)) - allocate(physics_process(iprc)%itend%dq(nlev_data)) - if (iprc == proc_SWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (proc_SWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_LWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (proc_LWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_LWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_GWD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (proc_GWD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_GWD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_PBL_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (proc_PBL_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_PBL_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_SCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (proc_SCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_DCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (proc_DCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_DCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_cldMP_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (proc_cldMP_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_cldMP_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - enddo - - ! Load data - physics_process(proc_LWRAD_config(3))%tend%time => time_data - physics_process(proc_SWRAD_config(3))%tend%time => time_data - physics_process(proc_PBL_config(3))%tend%time => time_data - physics_process(proc_GWD_config(3))%tend%time => time_data - physics_process(proc_DCNV_config(3))%tend%time => time_data - physics_process(proc_SCNV_config(3))%tend%time => time_data - physics_process(proc_cldMP_config(3))%tend%time => time_data - if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%q => dqdt_cldMP_data - - ! Which process-scheme is "Active"? - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) then - iactive_scheme = iprc - endif - enddo - - ! - if (mpirank .eq. mpiroot) then - print*, "----------------------------------" - print*, "--- Using CCPP data tendencies ---" - print*, "----------------------------------" - do iprc = 1,nPhysProcess - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - endif - enddo - print*, " active_scheme: ", trim(physics_process(iactive_scheme)%name) - print*, " order: ", physics_process(iactive_scheme)%order - print*, " time_split : ", physics_process(iactive_scheme)%time_split - print*, "----------------------------------" - print*, "----------------------------------" - endif - - end subroutine ccpp_scheme_simulator_init +contains ! ###################################################################################### ! @@ -662,7 +124,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Locals integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process real(kind_phys) :: w1, w2,hrofday real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt @@ -690,7 +152,27 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) - ! Set state + ! Get tendency for "active" process. + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by the + ! physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option "fhzero". + ! For this to work, you need to clear the diagnostic buckets after each physics timestep when + ! running in the UFS/SCM. + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + if (active_name == "LWRAD") index_of_active_process = index_of_process_longwave + if (active_name == "SWRAD") index_of_active_process = index_of_process_shortwave + if (active_name == "PBL") index_of_active_process = index_of_process_pbl + if (active_name == "GWD") index_of_active_process = index_of_process_orographic_gwd + if (active_name == "SCNV") index_of_active_process = index_of_process_scnv + if (active_name == "DCNV") index_of_active_process = index_of_process_dcnv + if (active_name == "cldMP") index_of_active_process = index_of_process_mp + + ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) gv1(:,:) = vgrs(:,:) @@ -700,70 +182,67 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:,1)= 0. - ! Model internal physics timestep evolution of "state". - do iprc = 1,nPhysProcess + ! Internal physics timestep evolution. + do iprc = proc_start,proc_end + if (iprc == iactive_scheme .and. active_time_split_process) then + proc_start = iactive_scheme + exit + endif + do iCol = 1,nCol ! Reset locals - physics_process(iprc)%itend%dT(:) = 0. - physics_process(iprc)%itend%du(:) = 0. - physics_process(iprc)%itend%dv(:) = 0. - physics_process(iprc)%itend%dq(:) = 0. + physics_process(iprc)%tend1d%T(:) = 0. + physics_process(iprc)%tend1d%u(:) = 0. + physics_process(iprc)%tend1d%v(:) = 0. + physics_process(iprc)%tend1d%q(:,1) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then - if (associated(physics_process(iprc)%tend%T)) then + if (associated(physics_process(iprc)%tend2d%T)) then errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%u)) then + if (associated(physics_process(iprc)%tend2d%u)) then errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%v)) then + if (associated(physics_process(iprc)%tend2d%v)) then errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%q)) then + if (associated(physics_process(iprc)%tend2d%q)) then errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif ! Using data tendency from "active" scheme(s). - ! DJS2023: This block is very ufs specific. Need to tidy this up. + ! DJS2023: This block is very ufs specific. See Note Above. else - if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave - if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave - if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl - if (physics_process(iprc)%name == "GWD") index_of_process = index_of_process_orographic_gwd - if (physics_process(iprc)%name == "SCNV") index_of_process = index_of_process_scnv - if (physics_process(iprc)%name == "DCNV") index_of_process = index_of_process_dcnv - if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp - ! - idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dT = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_temperature,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%T = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%du = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_x_wind,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%u = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dv = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_y_wind,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dq = dtend(iCol,:,idtend)/dtp + idtend = dtidx(100+ntqv,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%q(:,1) = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%itend%dT)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%itend%du)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%itend%dv)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%itend%dq)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1))*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%itend%dT - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%itend%du - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%itend%dv - dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%itend%dq + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v + dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1) endif enddo ! @@ -771,13 +250,18 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp - enddo + + if (iprc == proc_end) then + proc_start = 1 + endif ! end subroutine ccpp_scheme_simulator_run ! #################################################################################### - ! Utility functions/routines + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. ! #################################################################################### function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) class(base_physics_process), intent(inout) :: this @@ -785,27 +269,92 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu integer, intent(in) :: year, month, day, hour, minute, second character(len=128) :: err_message integer :: ti(1), tf(1) - real(kind_phys) :: w1, w2, hrofday + real(kind_phys) :: w1, w2 ! Interpolation weights - hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(this%tend%time-hrofday),minval(abs(this%tend%time-hrofday))) - if (hrofday - this%tend%time(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (this%tend%time(tf(1))-hrofday) / (this%tend%time(tf(1)) - this%tend%time(ti(1))) - w2 = 1 - w1 + call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) select case(var_name) case("T") - this%itend%dT = w1*this%tend%T(:,ti(1)) + w2*this%tend%T(:,tf(1)) + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) case("u") - this%itend%du = w1*this%tend%u(:,ti(1)) + w2*this%tend%u(:,tf(1)) + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) case("v") - this%itend%dv = w1*this%tend%v(:,ti(1)) + w2*this%tend%v(:,tf(1)) + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) case("q") - this%itend%dq = w1*this%tend%q(:,ti(1),1) + w2*this%tend%q(:,tf(1),1) + this%tend1d%q(:,1) = w1*this%tend2d%q(:,ti(1),1) + w2*this%tend2d%q(:,tf(1),1) end select end function linterp_1D - + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. + ! This assumes that the location dimension has a [longitude, latitude] associated with + ! each location. + ! #################################################################################### + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, second) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, minute, second + real(kind_phys), intent(in) :: lon, lat + character(len=128) :: err_message + integer :: ti(1), tf(1), iNearest + real(kind_phys) :: w1, w2 + + ! Interpolation weights (temporal) + call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + + ! Grab data tendency closest to column [lon,lat] + iNearest = this%find_nearest_loc_2d_1d(lon,lat) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) + case("q") + this%tend1d%q(:,1) = w1*this%tend3d%q(iNearest,:,ti(1),1) + w2*this%tend3d%q(iNearest,:,tf(1),1) + end select + end function linterp_2D + + ! #################################################################################### + ! Type-bound procedure to find nearest location. + ! + ! For use with linterp_2D, NOT YET IMPLEMENTED. + ! #################################################################################### + pure function find_nearest_loc_2d_1d(this, lon, lat) + class(base_physics_process), intent(in) :: this + real(kind_phys), intent(in) :: lon, lat + integer :: find_nearest_loc_2d_1d + + find_nearest_loc_2d_1d = 1 + end function find_nearest_loc_2d_1d + + ! #################################################################################### + ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) + ! forcing. + ! #################################################################################### + subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti, tf) + ! Inputs + class(base_physics_process), intent(in) :: this + integer, intent(in) :: year, month, day, hour, minute, second + ! Outputs + integer,intent(out) :: ti(1), tf(1) + real(kind_phys),intent(out) :: w1, w2 + ! Locals + real(kind_phys) :: hrofday + + hrofday = hour*3600. + minute*60. + second + ti = findloc(abs(this%tend2d%time-hrofday),minval(abs(this%tend2d%time-hrofday))) + if (hrofday - this%tend2d%time(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (this%tend2d%time(tf(1))-hrofday) / (this%tend2d%time(tf(1)) - this%tend2d%time(ti(1))) + w2 = 1 - w1 + + end subroutine cmp_time_wts + end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 80f898ed2..02bf17285 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -3,62 +3,6 @@ type = scheme dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = ccpp_scheme_simulator_init - type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[nlunit] - standard_name = iounit_of_namelist - long_name = fortran unit number for opening nameliust file - units = none - dimensions = () - type = integer - intent = in -[nml_file] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - dimensions = () - type = character - kind = len=* - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = ccpp_scheme_simulator_run diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 new file mode 100644 index 000000000..1041e113c --- /dev/null +++ b/physics/load_ccpp_scheme_sim.F90 @@ -0,0 +1,577 @@ +! ######################################################################################## +! +! CCPP scheme to read and load data for ccpp_scheme_simulator +! +! ######################################################################################## +module load_ccpp_scheme_sim + use machine, only: kind_phys + use netcdf + use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& + iactive_scheme, proc_start, proc_end, active_time_split_process +#ifdef MPI + use mpi +#endif + implicit none + + ! ######################################################################################## + ! + ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to + ! populate "physics_process" type array, defined in ccpp_scheme_simulator.F90 + ! + ! ######################################################################################## + + ! Number of physics process (set in namelist) + integer :: nPhysProcess + + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + proc_LWRAD_config = (/0,0,0/), & + proc_SWRAD_config = (/0,0,0/), & + proc_PBL_config = (/0,0,0/), & + proc_GWD_config = (/0,0,0/), & + proc_SCNV_config = (/0,0,0/), & + proc_DCNV_config = (/0,0,0/), & + proc_cldMP_config = (/0,0,0/) + + ! Activation flag for scheme. + logical :: do_load_ccpp_scheme = .false. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data + real(kind_phys), allocatable, dimension(:), target :: time_data + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + + ! Scheme initialization flag. + logical :: module_initialized = .false. + + public load_ccpp_scheme_sim_init +contains + + ! ###################################################################################### + ! + ! SUBROUTINE load_ccpp_scheme_sim_init + ! + ! ###################################################################################### +!! \section arg_table_load_ccpp_scheme_sim_init +!! \htmlinclude load_ccpp_scheme_sim_init.html +!! + subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & + errmsg, errflg) + + ! Inputs + integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc + character(len=256) :: fileIN + logical :: exists + integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + + ! Namelist + namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & + proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & + proc_cldMP_config + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (module_initialized) return + module_initialized = .true. + + ! ###################################################################################### + ! + ! Part A) Read in namelist and data. + ! + ! ###################################################################################### + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = scm_data_nml) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & + proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & + proc_cldMP_config(1)) then + do_ccpp_scheme_simulator = .true. + else + return + endif + + ! Check that input data file exists + inquire (file = trim (fileIN), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif + + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast dimensions... + ! (ALL processors) + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! + ! What data fields do we have? + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. + +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + ! + status = nf90_close(ncid) + +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast data... + ! (ALL processors) + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + ! + call mpi_barrier(mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Part B) Populate physics_process type. + ! + ! ####################################################################################### + ! Default process extent (no time-split physics processes) + proc_start = 1 + proc_end = nPhysProcess + + ! Allocate + allocate(physics_process(nPhysProcess)) + + ! Metadata + do iprc = 1,nPhysProcess + allocate(physics_process(iprc)%tend1d%T(nlev_data)) + allocate(physics_process(iprc)%tend1d%u(nlev_data)) + allocate(physics_process(iprc)%tend1d%v(nlev_data)) + allocate(physics_process(iprc)%tend1d%q(nlev_data,1)) + if (iprc == proc_SWRAD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (proc_SWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_LWRAD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (proc_LWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_LWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_GWD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (proc_GWD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_GWD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_PBL_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (proc_PBL_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_PBL_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_SCNV_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (proc_SCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_DCNV_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (proc_DCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_DCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_cldMP_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (proc_cldMP_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_cldMP_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + enddo + + ! Load data + physics_process(proc_LWRAD_config(3))%tend2d%time => time_data + physics_process(proc_SWRAD_config(3))%tend2d%time => time_data + physics_process(proc_PBL_config(3))%tend2d%time => time_data + physics_process(proc_GWD_config(3))%tend2d%time => time_data + physics_process(proc_DCNV_config(3))%tend2d%time => time_data + physics_process(proc_SCNV_config(3))%tend2d%time => time_data + physics_process(proc_cldMP_config(3))%tend2d%time => time_data + if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend2d%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend2d%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data + + ! Which process-scheme is "Active"? Is it a time-split process? + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) then + iactive_scheme = iprc + active_name = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + active_time_split_process = .true. + endif + endif + enddo + + ! + if (mpirank .eq. mpiroot) then + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + do iprc = 1,nPhysProcess + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + endif + enddo + print*, " active_scheme: ", trim(active_name) + print*, " order: ", physics_process(iactive_scheme)%order + print*, " time_split : ", active_time_split_process + print*, "-----------------------------------" + print*, "-----------------------------------" + endif + + end subroutine load_ccpp_scheme_sim_init + +end module load_ccpp_scheme_sim diff --git a/physics/load_ccpp_scheme_sim.meta b/physics/load_ccpp_scheme_sim.meta new file mode 100644 index 000000000..6e0aea925 --- /dev/null +++ b/physics/load_ccpp_scheme_sim.meta @@ -0,0 +1,60 @@ +[ccpp-table-properties] + name = load_ccpp_scheme_sim + type = scheme + dependencies = machine.F,ccpp_scheme_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = load_ccpp_scheme_sim_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in +[nml_file] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out From 8bc8ec909ea493714aa9c8325cd5bb93ef204225 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 11:15:06 -0700 Subject: [PATCH 012/122] Small bug fix to nml --- physics/load_ccpp_scheme_sim.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index 1041e113c..db2181cf3 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -127,7 +127,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) endif rewind (nlunit) - read (nlunit, nml = scm_data_nml) + read (nlunit, nml = scm_data_nml, iostat=status) close (nlunit) ! Only proceed if scheme simulator requested. From 6db4af5baeb306f24466bc601b0b42e787f6cb0c Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 16:52:20 -0700 Subject: [PATCH 013/122] Remove dimension for tracer, handle tracers individualy, not with stacked array --- physics/ccpp_scheme_simulator.F90 | 126 +++++++++++++++-------------- physics/ccpp_scheme_simulator.meta | 4 +- physics/load_ccpp_scheme_sim.F90 | 13 +-- 3 files changed, 74 insertions(+), 69 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 3b478844f..4fffc8bb5 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -15,41 +15,41 @@ module ccpp_scheme_simulator ! ######################################################################################## ! Type containing 1D (time) physics tendencies. type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:), pointer :: q end type phys_tend_1d ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q end type phys_tend_2d ! Type containing 3D (loc,lev,time) physics tendencies. type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q end type phys_tend_3d ! Type containing 4D (lon, lat,lev,time) physics tendencies. type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q end type phys_tend_4d ! This type contains the meta information and data for each physics process. @@ -118,16 +118,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 + real(kind_phys), intent(inout), dimension(:,:) :: gq0 character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg ! Locals - integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process + integer :: iCol, iLay, nCol, nLay, idtend, fcst_year, fcst_month, fcst_day, & + fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt - real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt + real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' @@ -144,13 +144,12 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti fcst_sec = jdat(7) ! Dimensions - nCol = size(gq0(:,1,1)) - nLay = size(gq0(1,:,1)) - nTrc = size(gq0(1,1,:)) + nCol = size(gq0(:,1)) + nLay = size(gq0(1,:)) ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) - allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay)) + allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay)) ! Get tendency for "active" process. ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional @@ -173,14 +172,14 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (active_name == "cldMP") index_of_active_process = index_of_process_mp ! Set state at beginning of the physics timestep. - gt1(:,:) = tgrs(:,:) - gu1(:,:) = ugrs(:,:) - gv1(:,:) = vgrs(:,:) - gq1(:,:,1) = qgrs(:,:,1) - dTdt(:,:) = 0. - dudt(:,:) = 0. - dvdt(:,:) = 0. - dqdt(:,:,1)= 0. + gt1(:,:) = tgrs(:,:) + gu1(:,:) = ugrs(:,:) + gv1(:,:) = vgrs(:,:) + gq1(:,:) = qgrs(:,:,1) + dTdt(:,:) = 0. + dudt(:,:) = 0. + dvdt(:,:) = 0. + dqdt(:,:) = 0. ! Internal physics timestep evolution. do iprc = proc_start,proc_end @@ -188,13 +187,14 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti proc_start = iactive_scheme exit endif + print*,'Simulating ',iprc,' of ',proc_end do iCol = 1,nCol ! Reset locals physics_process(iprc)%tend1d%T(:) = 0. physics_process(iprc)%tend1d%u(:) = 0. physics_process(iprc)%tend1d%v(:) = 0. - physics_process(iprc)%tend1d%q(:,1) = 0. + physics_process(iprc)%tend1d%q(:) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then @@ -224,32 +224,35 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%q(:,1) = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%tend1d%q = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1))*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:,1) = 0. + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v - dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1) + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v + dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif enddo ! - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp + do iLay=1,nLay + write(*,'(i3,6f13.6)') ilay, gt0(iCol,iLay) , gt1(iCol,iLay) , dTdt(iCol,iLay)*dtp,physics_process(iprc)%tend1d%T(iLay),physics_process(iprc)%tend2d%T(iLay,3),physics_process(iprc)%tend2d%T(iLay,4) + enddo + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo if (iprc == proc_end) then @@ -273,6 +276,7 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + print*,w1,w2,ti,tf select case(var_name) case("T") @@ -282,7 +286,7 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu case("v") this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) case("q") - this%tend1d%q(:,1) = w1*this%tend2d%q(:,ti(1),1) + w2*this%tend2d%q(:,tf(1),1) + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) end select end function linterp_1D @@ -317,7 +321,7 @@ function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, se case("v") this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) case("q") - this%tend1d%q(:,1) = w1*this%tend3d%q(iNearest,:,ti(1),1) + w2*this%tend3d%q(iNearest,:,tf(1),1) + this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) end select end function linterp_2D diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 02bf17285..c0dc2f172 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -178,10 +178,10 @@ kind = kind_phys intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = specific_humidity_of_new_state long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index db2181cf3..b23c15839 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -44,7 +44,7 @@ module load_ccpp_scheme_sim dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data ! Scheme initialization flag. @@ -262,7 +262,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) @@ -271,13 +271,13 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) ! Read in data ... ! (ONLY master processor(0), if MPI enabled) @@ -301,6 +301,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + print*,'dTdt_SWRAD_data: ',dTdt_SWRAD_data ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) @@ -441,7 +442,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file allocate(physics_process(iprc)%tend1d%T(nlev_data)) allocate(physics_process(iprc)%tend1d%u(nlev_data)) allocate(physics_process(iprc)%tend1d%v(nlev_data)) - allocate(physics_process(iprc)%tend1d%q(nlev_data,1)) + allocate(physics_process(iprc)%tend1d%q(nlev_data)) if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" From 147cbac00de18dbf4d705d235ec90fcde9dd4ba3 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 21:33:15 -0700 Subject: [PATCH 014/122] Fixed bug in interpolation routine. --- physics/ccpp_scheme_simulator.F90 | 57 +++++++++++++++++++++--------- physics/ccpp_scheme_simulator.meta | 16 +++++++++ physics/load_ccpp_scheme_sim.F90 | 5 +-- 3 files changed, 57 insertions(+), 21 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 4fffc8bb5..957a97862 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -82,6 +82,8 @@ module ccpp_scheme_simulator integer :: iactive_scheme integer :: proc_start, proc_end logical :: active_time_split_process=.false. + logical :: in_pre_active = .true. + logical :: in_post_active = .false. ! Set to true in data was loaded into "physics_process" logical :: do_ccpp_scheme_simulator=.false. @@ -103,7 +105,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & - errmsg, errflg) + dtdq_pbl, dtdq_mp, errmsg, errflg) ! Inputs integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & @@ -118,7 +120,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:) :: gq0 + real(kind_phys), intent(inout), dimension(:,:) :: gq0, dtdq_pbl, dtdq_mp character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg @@ -181,13 +183,22 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:) = 0. + if (in_pre_active) then + proc_start = 1 + proc_end = iactive_scheme-1 + endif + if (in_post_active) then + proc_start = iactive_scheme + proc_end = size(physics_process) + endif + ! Internal physics timestep evolution. do iprc = proc_start,proc_end if (iprc == iactive_scheme .and. active_time_split_process) then - proc_start = iactive_scheme - exit + print*,'Reached active process. ', iprc + else + print*,'Simulating ',iprc,' of ',proc_end endif - print*,'Simulating ',iprc,' of ',proc_end do iCol = 1,nCol ! Reset locals @@ -233,10 +244,10 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:) = 0. + !dTdt(iCol,:) = 0. + !dudt(iCol,:) = 0. + !dvdt(iCol,:) = 0. + !dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T @@ -244,10 +255,17 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif + ! These are needed by samfshalcnv + if (trim(physics_process(iprc)%name) == "PBL") then + dtdq_pbl(iCol,:) = physics_process(iprc)%tend1d%q + endif + if (trim(physics_process(iprc)%name) == "cldMP") then + dtdq_mp(iCol,:) = physics_process(iprc)%tend1d%q + endif enddo ! do iLay=1,nLay - write(*,'(i3,6f13.6)') ilay, gt0(iCol,iLay) , gt1(iCol,iLay) , dTdt(iCol,iLay)*dtp,physics_process(iprc)%tend1d%T(iLay),physics_process(iprc)%tend2d%T(iLay,3),physics_process(iprc)%tend2d%T(iLay,4) + !write(*,'(i3,4f13.6)') ilay, gq0(iCol,iLay) , gq1(iCol,iLay) , dqdt(iCol,iLay)*dtp, physics_process(iprc)%tend1d%q(iLay)*dtp enddo gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp @@ -255,9 +273,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo - if (iprc == proc_end) then - proc_start = 1 + if (in_pre_active) then + in_pre_active = .false. + in_post_active = .true. endif + + if (size(physics_process)+1 == iprc) then + in_pre_active = .true. + in_post_active = .false. + endif + ! end subroutine ccpp_scheme_simulator_run @@ -276,7 +301,6 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) - print*,w1,w2,ti,tf select case(var_name) case("T") @@ -353,10 +377,9 @@ subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti real(kind_phys) :: hrofday hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(this%tend2d%time-hrofday),minval(abs(this%tend2d%time-hrofday))) - if (hrofday - this%tend2d%time(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (this%tend2d%time(tf(1))-hrofday) / (this%tend2d%time(tf(1)) - this%tend2d%time(ti(1))) + ti = max(hour,1) + tf = min(ti + 1,24) + w1 = ((hour+1)*3600 - hrofday)/3600 w2 = 1 - w1 end subroutine cmp_time_wts diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index c0dc2f172..888ba2f8d 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -185,6 +185,22 @@ type = real kind = kind_phys intent = inout +[dtdq_pbl] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdq_mp] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics + long_name = moisture tendency due to microphysics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index b23c15839..8f4c7ee57 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -7,7 +7,7 @@ module load_ccpp_scheme_sim use machine, only: kind_phys use netcdf use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, proc_start, proc_end, active_time_split_process + iactive_scheme, active_time_split_process #ifdef MPI use mpi #endif @@ -430,9 +430,6 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file ! Part B) Populate physics_process type. ! ! ####################################################################################### - ! Default process extent (no time-split physics processes) - proc_start = 1 - proc_end = nPhysProcess ! Allocate allocate(physics_process(nPhysProcess)) From a29638959bf2202d3132b8e5ae57db7774213f1d Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 16 Feb 2023 21:02:27 -0700 Subject: [PATCH 015/122] Moew changes --- physics/ccpp_scheme_simulator.F90 | 230 +++++++++++++++++++++++------- physics/load_ccpp_scheme_sim.F90 | 31 ++-- 2 files changed, 203 insertions(+), 58 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 957a97862..f75580fb9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -74,14 +74,18 @@ module ccpp_scheme_simulator type(base_physics_process), dimension(:), allocatable :: & physics_process + ! Do not change these! ! For time-split physics process we need to call this scheme twice in the SDF, once ! before the "active" scheme is called, and once after. This is because the active ! scheme uses an internal physics state that has been advanced forward by a subsequent ! physics process(es). - character(len=16) :: active_name - integer :: iactive_scheme + integer :: nactive_proc + character(len=16),allocatable,dimension(:) :: active_name + integer,allocatable,dimension(:) :: iactive_scheme + logical,allocatable,dimension(:) :: active_time_split_process + integer :: iactive_scheme_inloop = 1 + integer :: proc_start, proc_end - logical :: active_time_split_process=.false. logical :: in_pre_active = .true. logical :: in_post_active = .false. @@ -125,8 +129,8 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti integer, intent(out) :: errflg ! Locals - integer :: iCol, iLay, nCol, nLay, idtend, fcst_year, fcst_month, fcst_day, & - fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process + integer :: iCol, iLay, nCol, nLay, idtend, year, month, day, hour, min, sec, iprc, & + index_of_active_process real(kind_phys) :: w1, w2,hrofday real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt @@ -138,12 +142,12 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (.not. do_ccpp_scheme_simulator) return ! Current forecast time (Data-format specific) - fcst_year = jdat(1) - fcst_month = jdat(2) - fcst_day = jdat(3) - fcst_hour = jdat(5) - fcst_min = jdat(6) - fcst_sec = jdat(7) + year = jdat(1) + month = jdat(2) + day = jdat(3) + hour = jdat(5) + min = jdat(6) + sec = jdat(7) ! Dimensions nCol = size(gq0(:,1)) @@ -165,13 +169,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! In the SCM this is done by adding the following runtime options: ! --n_itt_out 1 --n_itt_diag 1 ! - if (active_name == "LWRAD") index_of_active_process = index_of_process_longwave - if (active_name == "SWRAD") index_of_active_process = index_of_process_shortwave - if (active_name == "PBL") index_of_active_process = index_of_process_pbl - if (active_name == "GWD") index_of_active_process = index_of_process_orographic_gwd - if (active_name == "SCNV") index_of_active_process = index_of_process_scnv - if (active_name == "DCNV") index_of_active_process = index_of_process_dcnv - if (active_name == "cldMP") index_of_active_process = index_of_process_mp + if (active_name(iactive_scheme_inloop) == "LWRAD") index_of_active_process = index_of_process_longwave + if (active_name(iactive_scheme_inloop) == "SWRAD") index_of_active_process = index_of_process_shortwave + if (active_name(iactive_scheme_inloop) == "PBL") index_of_active_process = index_of_process_pbl + if (active_name(iactive_scheme_inloop) == "GWD") index_of_active_process = index_of_process_orographic_gwd + if (active_name(iactive_scheme_inloop) == "SCNV") index_of_active_process = index_of_process_scnv + if (active_name(iactive_scheme_inloop) == "DCNV") index_of_active_process = index_of_process_dcnv + if (active_name(iactive_scheme_inloop) == "cldMP") index_of_active_process = index_of_process_mp ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) @@ -185,16 +189,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (in_pre_active) then proc_start = 1 - proc_end = iactive_scheme-1 + proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) endif if (in_post_active) then - proc_start = iactive_scheme + proc_start = iactive_scheme(iactive_scheme_inloop) proc_end = size(physics_process) endif ! Internal physics timestep evolution. do iprc = proc_start,proc_end - if (iprc == iactive_scheme .and. active_time_split_process) then + if (iprc == iactive_scheme(iactive_scheme_inloop)) then print*,'Reached active process. ', iprc else print*,'Simulating ',iprc,' of ',proc_end @@ -209,17 +213,26 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then - if (associated(physics_process(iprc)%tend2d%T)) then - errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "LWRAD") then + call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "SWRAD")then + call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "GWD")then + call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "PBL")then + call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%u)) then - errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "SCNV")then + call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%v)) then - errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "DCNV")then + call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%q)) then - errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "cldMP")then + call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) endif ! Using data tendency from "active" scheme(s). @@ -240,28 +253,23 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Update state now? if (physics_process(iprc)%time_split) then + print*,' time-split scheme...' gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - !dTdt(iCol,:) = 0. - !dudt(iCol,:) = 0. - !dvdt(iCol,:) = 0. - !dqdt(iCol,:) = 0. + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else + print*,' process-split scheme...' dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif - ! These are needed by samfshalcnv - if (trim(physics_process(iprc)%name) == "PBL") then - dtdq_pbl(iCol,:) = physics_process(iprc)%tend1d%q - endif - if (trim(physics_process(iprc)%name) == "cldMP") then - dtdq_mp(iCol,:) = physics_process(iprc)%tend1d%q - endif enddo ! do iLay=1,nLay @@ -281,6 +289,11 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (size(physics_process)+1 == iprc) then in_pre_active = .true. in_post_active = .false. + iactive_scheme_inloop = 1 + endif + + if (iactive_scheme_inloop < nactive_proc) then + iactive_scheme_inloop = iactive_scheme_inloop + 1 endif ! @@ -291,16 +304,16 @@ end subroutine ccpp_scheme_simulator_run ! ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) + function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: err_message integer :: ti(1), tf(1) real(kind_phys) :: w1, w2 ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) select case(var_name) case("T") @@ -322,17 +335,17 @@ end function linterp_1D ! This assumes that the location dimension has a [longitude, latitude] associated with ! each location. ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, second) result(err_message) + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, min, sec real(kind_phys), intent(in) :: lon, lat character(len=128) :: err_message integer :: ti(1), tf(1), iNearest real(kind_phys) :: w1, w2 ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) ! Grab data tendency closest to column [lon,lat] iNearest = this%find_nearest_loc_2d_1d(lon,lat) @@ -366,17 +379,17 @@ end function find_nearest_loc_2d_1d ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) ! forcing. ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti, tf) + subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) ! Inputs class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, minute, sec ! Outputs integer,intent(out) :: ti(1), tf(1) real(kind_phys),intent(out) :: w1, w2 ! Locals real(kind_phys) :: hrofday - hrofday = hour*3600. + minute*60. + second + hrofday = hour*3600. + minute*60. + sec ti = max(hour,1) tf = min(ti + 1,24) w1 = ((hour+1)*3600 - hrofday)/3600 @@ -384,4 +397,123 @@ subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti end subroutine cmp_time_wts + ! #################################################################################### + subroutine sim_LWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_LWRAD + + ! #################################################################################### + subroutine sim_SWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_SWRAD + + ! #################################################################################### + subroutine sim_GWD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + + end subroutine sim_GWD + + ! #################################################################################### + subroutine sim_PBL( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_PBL + + ! #################################################################################### + subroutine sim_DCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_DCNV + + ! #################################################################################### + subroutine sim_SCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_SCNV + + ! #################################################################################### + subroutine sim_cldMP( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + end subroutine sim_cldMP + end module ccpp_scheme_simulator diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index 8f4c7ee57..1fb3dc983 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -7,7 +7,7 @@ module load_ccpp_scheme_sim use machine, only: kind_phys use netcdf use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, active_time_split_process + iactive_scheme, active_time_split_process, nactive_proc #ifdef MPI use mpi #endif @@ -73,7 +73,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality @@ -540,13 +540,23 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data - ! Which process-scheme is "Active"? Is it a time-split process? + ! How many active schemes are there? + nactive_proc = 0 + iactive = 0 + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) nactive_proc = nactive_proc + 1 + enddo + allocate(iactive_scheme(nactive_proc),active_name(nactive_proc),active_time_split_process(nactive_proc)) + + ! Which process-scheme(s) is(are) "Active"? Are they time-split process? + active_time_split_process(:) = .false. do iprc = 1,nPhysProcess if (.not. physics_process(iprc)%use_sim) then - iactive_scheme = iprc - active_name = physics_process(iprc)%name + iactive = iactive + 1 + iactive_scheme(iactive) = iprc + active_name(iactive) = physics_process(iprc)%name if (physics_process(iprc)%time_split) then - active_time_split_process = .true. + active_time_split_process(iactive) = .true. endif endif enddo @@ -556,16 +566,19 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file print*, "-----------------------------------" print*, "--- Using CCPP scheme simulator ---" print*, "-----------------------------------" + iactive = 1 do iprc = 1,nPhysProcess if (physics_process(iprc)%use_sim) then print*," simulate_scheme: ", trim(physics_process(iprc)%name) print*," order: ", physics_process(iprc)%order print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(active_name(iactive)) + print*, " order: ", physics_process(iactive_scheme(iactive))%order + print*, " time_split : ", active_time_split_process(iactive) + iactive = iactive + 1 endif enddo - print*, " active_scheme: ", trim(active_name) - print*, " order: ", physics_process(iactive_scheme)%order - print*, " time_split : ", active_time_split_process print*, "-----------------------------------" print*, "-----------------------------------" endif From 40e092d0d92d0c78848acc47ae83629908375a6c Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 23 Feb 2023 14:28:26 -0700 Subject: [PATCH 016/122] add runoff and drain to land coupling --- physics/sfc_land.f | 19 +++++++++++++++---- physics/sfc_land.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 4 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index ab0691251..f7aebe171 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,9 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + & runoff_lnd, drain_lnd, ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, & + & gflux, runoff, drain, & & errmsg, errflg, naux2d, aux2d & ) @@ -54,9 +55,10 @@ subroutine sfc_land_run & ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! +! runoff_lnd, drain_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, ! +! gflux, runoff, drain, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -75,6 +77,8 @@ subroutine sfc_land_run & ! t2mmp_lnd - real , 2m temperature ! q2mp_lnd - real , 2m specific humidity ! gflux_lnd - real , soil heat flux over land +! runoff_lnd - real , surface runoff +! drain_lnd - real , subsurface runoff ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -84,6 +88,8 @@ subroutine sfc_land_run & ! t2mmp - real , temperature at 2m ! q2mp - real , specific humidity at 2m ! gflux - real , soil heat flux over land +! runoff - real , surface runoff +! drain - real , subsurface runoff ! ==================== end of description ===================== ! ! ! @@ -98,11 +104,12 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & + & runoff, drain ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -129,6 +136,8 @@ subroutine sfc_land_run & t2mmp(i) = t2mmp_lnd(i) q2mp(i) = q2mp_lnd(i) gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -139,6 +148,8 @@ subroutine sfc_land_run & aux2d(:,6) = t2mmp(:) aux2d(:,7) = q2mp(:) aux2d(:,8) = gflux(:) + aux2d(:,9) = drain(:) + aux2d(:,10) = runoff(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 50ddecd46..60a853b89 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -106,6 +106,22 @@ type = real kind = kind_phys intent = in +[runoff_lnd] + standard_name = surface_runoff_flux_from_land + long_name = surface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[drain_lnd] + standard_name = subsurface_runoff_flux_from_land + long_name = subsurface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -170,6 +186,22 @@ type = real kind = kind_phys intent = out +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 64fdd5aa53672132bf1295701a9d7844232f336b Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Mar 2023 11:00:00 -0700 Subject: [PATCH 017/122] add exchange coefficents --- physics/sfc_land.f | 23 ++++++++++++++++------- physics/sfc_land.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 7 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index f7aebe171..0436519a5 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,10 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, + & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, & + & gflux, runoff, drain, cmm, chh, & & errmsg, errflg, naux2d, aux2d & ) @@ -55,10 +55,10 @@ subroutine sfc_land_run & ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! -! runoff_lnd, drain_lnd, ! +! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, ! +! gflux, runoff, drain, cmm, chh, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -79,6 +79,8 @@ subroutine sfc_land_run & ! gflux_lnd - real , soil heat flux over land ! runoff_lnd - real , surface runoff ! drain_lnd - real , subsurface runoff +! cmm_lnd - real , surface drag wind speed for momentum +! chh_lnd - real , surface drag mass flux for heat and moisture ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -89,7 +91,9 @@ subroutine sfc_land_run & ! q2mp - real , specific humidity at 2m ! gflux - real , soil heat flux over land ! runoff - real , surface runoff -! drain - real , subsurface runoff +! drain - real , subsurface runoff +! cmm - real , surface drag wind speed for momentum +! chh - real , surface drag mass flux for heat and moisture ! ==================== end of description ===================== ! ! ! @@ -104,12 +108,13 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & + & cmm_lnd, chh_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain + & runoff, drain, cmm, chh ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -138,6 +143,8 @@ subroutine sfc_land_run & gflux(i) = gflux_lnd(i) drain(i) = drain_lnd(i) runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -150,6 +157,8 @@ subroutine sfc_land_run & aux2d(:,8) = gflux(:) aux2d(:,9) = drain(:) aux2d(:,10) = runoff(:) + aux2d(:,11) = cmm(:) + aux2d(:,12) = chh(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 60a853b89..99a795c65 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -122,6 +122,22 @@ type = real kind = kind_phys intent = in +[cmm_lnd] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land_from_land + long_name = momentum exchange coefficient over land for coupling + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[chh_lnd] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land_from_land + long_name = thermal exchange coefficient over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -202,6 +218,22 @@ type = real kind = kind_phys intent = out +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 91a9b44eac42dfaf047cfc79718fa0332db0979d Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Mar 2023 22:40:41 -0700 Subject: [PATCH 018/122] add zvfun to land coupling --- physics/sfc_land.f | 15 ++++++++++----- physics/sfc_land.meta | 16 ++++++++++++++++ 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 0436519a5..44a9b5a06 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,10 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, + & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, cmm, chh, & + & gflux, runoff, drain, cmm, chh, zvfun, & & errmsg, errflg, naux2d, aux2d & ) @@ -56,9 +56,10 @@ subroutine sfc_land_run & ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! ! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! +! zvfun_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, cmm, chh, ! +! gflux, runoff, drain, cmm, chh, zvfun, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -81,6 +82,7 @@ subroutine sfc_land_run & ! drain_lnd - real , subsurface runoff ! cmm_lnd - real , surface drag wind speed for momentum ! chh_lnd - real , surface drag mass flux for heat and moisture +! zvfun_lnd - real , function of surface roughness length and green vegetation fraction ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -94,6 +96,7 @@ subroutine sfc_land_run & ! drain - real , subsurface runoff ! cmm - real , surface drag wind speed for momentum ! chh - real , surface drag mass flux for heat and moisture +! zvfun - real , function of surface roughness length and green vegetation fraction ! ==================== end of description ===================== ! ! ! @@ -109,12 +112,12 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & - & cmm_lnd, chh_lnd + & cmm_lnd, chh_lnd, zvfun_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain, cmm, chh + & runoff, drain, cmm, chh, zvfun ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -145,6 +148,7 @@ subroutine sfc_land_run & runoff(i) = runoff_lnd(i) cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -159,6 +163,7 @@ subroutine sfc_land_run & aux2d(:,10) = runoff(:) aux2d(:,11) = cmm(:) aux2d(:,12) = chh(:) + aux2d(:,13) = zvfun(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 99a795c65..a146dec3a 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -138,6 +138,14 @@ type = real kind = kind_phys intent = in +[zvfun_lnd] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction_from_land + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -234,6 +242,14 @@ type = real kind = kind_phys intent = out +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8442a202769b4082d548c4d0d0b5d0c1cb7a80c1 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 5 Apr 2023 15:49:56 -0600 Subject: [PATCH 019/122] clean sfc_land --- physics/sfc_land.f | 22 +--------------------- physics/sfc_land.meta | 15 --------------- 2 files changed, 1 insertion(+), 36 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 44a9b5a06..aec47ff77 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -27,9 +27,6 @@ module sfc_land !! \section detailed Detailed Algorithm !! @{ - -!! use physcons, only : hvap => con_hvap, cp => con_cp, & -!! & rvrdm1 => con_fvirt, rd => con_rd ! !----------------------------------- subroutine sfc_land_run & @@ -41,7 +38,7 @@ subroutine sfc_land_run & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & & gflux, runoff, drain, cmm, chh, zvfun, & - & errmsg, errflg, naux2d, aux2d + & errmsg, errflg & ) ! ===================================================================== ! @@ -122,9 +119,6 @@ subroutine sfc_land_run & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer, intent(in) :: naux2d - real(kind_phys), intent(out) :: aux2d(:,:) - ! --- locals: integer :: i @@ -150,20 +144,6 @@ subroutine sfc_land_run & chh(i) = chh_lnd(i) zvfun(i) = zvfun_lnd(i) enddo - - aux2d(:,1) = sncovr1(:) - aux2d(:,2) = qsurf(:) - aux2d(:,3) = hflx(:) - aux2d(:,4) = evap(:) - aux2d(:,5) = ep(:) - aux2d(:,6) = t2mmp(:) - aux2d(:,7) = q2mp(:) - aux2d(:,8) = gflux(:) - aux2d(:,9) = drain(:) - aux2d(:,10) = runoff(:) - aux2d(:,11) = cmm(:) - aux2d(:,12) = chh(:) - aux2d(:,13) = zvfun(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index a146dec3a..979cca377 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -265,18 +265,3 @@ dimensions = () type = integer intent = out -[naux2d] - standard_name = number_of_xy_dimensioned_auxiliary_arrays - long_name = number of 2d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer - intent = in -[aux2d] - standard_name = auxiliary_2d_arrays - long_name = auxiliary 2d arrays to output (for debugging) - units = none - dimensions = (horizontal_loop_extent,number_of_xy_dimensioned_auxiliary_arrays) - type = real - kind = kind_phys - intent = out From a3933a549c7ced2ae9f9c7b30b42090cfa2134ca Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 4 May 2023 11:20:02 -0600 Subject: [PATCH 020/122] CCPP scheme simulator --- physics/GFS_ccpp_scheme_sim_pre.F90 | 603 ++++++++++++++++++++++ physics/GFS_ccpp_scheme_sim_pre.meta | 295 +++++++++++ physics/ccpp_scheme_simulator.F90 | 450 +++------------- physics/ccpp_scheme_simulator.meta | 187 +++---- physics/module_ccpp_scheme_simulator.F90 | 302 +++++++++++ physics/module_ccpp_scheme_simulator.meta | 24 + 6 files changed, 1382 insertions(+), 479 deletions(-) create mode 100644 physics/GFS_ccpp_scheme_sim_pre.F90 create mode 100644 physics/GFS_ccpp_scheme_sim_pre.meta create mode 100644 physics/module_ccpp_scheme_simulator.F90 create mode 100644 physics/module_ccpp_scheme_simulator.meta diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 new file mode 100644 index 000000000..acd0c6692 --- /dev/null +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -0,0 +1,603 @@ +! ######################################################################################## +! +! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! ) _init: read and load data into type used by ccpp_scheme_simulator +! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! +! ######################################################################################## +module GFS_ccpp_scheme_sim_pre + use machine, only: kind_phys + use netcdf + use module_ccpp_scheme_simulator, only: base_physics_process +#ifdef MPI + use mpi +#endif + implicit none + + public GFS_ccpp_scheme_sim_pre_init, GFS_ccpp_scheme_sim_pre_run +contains + + ! ###################################################################################### + ! + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_init + ! + ! ###################################################################################### +!! \section arg_table_GFS_ccpp_scheme_sim_pre_init +!! \htmlinclude GFS_ccpp_scheme_sim_pre_init.html +!! + subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_scheme_sim, & + scheme_sim_data, nprg_active, nprc_sim, prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg,& + prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg, active_name, & + iactive_scheme, active_time_split_process, physics_process, errmsg, errflg) + + ! Inputs + integer, intent (in) :: mpirank, mpiroot, mpicomm, nprg_active, nprc_sim + logical, intent (in) :: do_ccpp_scheme_sim + character(len=256), intent (in) :: scheme_sim_data + integer, dimension(3), intent (in) :: prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, & + prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg + + ! Outputs + type(base_physics_process),intent(inout) :: physics_process(:) + character(len=16),intent(inout) :: active_name(:) + integer, intent(inout) :: iactive_scheme(:) + logical, intent(inout) :: active_time_split_process(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive + logical :: exists + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data + real(kind_phys), allocatable, dimension(:), target :: time_data + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_scheme_sim) return + + ! ###################################################################################### + ! + ! Part A) Read in data. + ! + ! ###################################################################################### + + ! Check that input data file exists + inquire (file = trim (scheme_sim_data), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not exist' + errflg = 1 + return + endif + + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(scheme_sim_data), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(scheme_sim_data) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast dimensions... + ! (ALL processors) + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! + ! What data fields do we have? + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. + +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) + + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + ! + status = nf90_close(ncid) + +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast data... + ! (ALL processors) + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + ! + call mpi_barrier(mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Part B) Populate physics_process type. + ! + ! ####################################################################################### + + ! Metadata + do iprc = 1,nprc_sim + if (iprc == prc_SWRAD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (prc_SWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_SWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_LWRAD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (prc_LWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_LWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_GWD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (prc_GWD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_GWD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_PBL_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (prc_PBL_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_PBL_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_SCNV_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (prc_SCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_SCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_DCNV_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (prc_DCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_DCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_cldMP_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (prc_cldMP_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_cldMP_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + enddo + + ! Load data + physics_process(prc_LWRAD_cfg(3))%tend2d%time => time_data + physics_process(prc_SWRAD_cfg(3))%tend2d%time => time_data + physics_process(prc_PBL_cfg(3))%tend2d%time => time_data + physics_process(prc_GWD_cfg(3))%tend2d%time => time_data + physics_process(prc_DCNV_cfg(3))%tend2d%time => time_data + physics_process(prc_SCNV_cfg(3))%tend2d%time => time_data + physics_process(prc_cldMP_cfg(3))%tend2d%time => time_data + if (have_dTdt_LWRAD_data) physics_process(prc_SWRAD_cfg(3))%tend2d%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(prc_LWRAD_cfg(3))%tend2d%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%q => dqdt_cldMP_data + + ! Which process-scheme(s) is(are) "Active"? Are they time-split process? + iactive = 0 + active_time_split_process(:) = .false. + do iprc = 1,nprc_sim + if (.not. physics_process(iprc)%use_sim) then + iactive = iactive + 1 + iactive_scheme(iactive) = iprc + active_name(iactive) = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + active_time_split_process(iactive) = .true. + endif + endif + enddo + + ! + if (mpirank .eq. mpiroot) then + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + iactive = 1 + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(active_name(iactive)) + print*, " order: ", physics_process(iactive_scheme(iactive))%order + print*, " time_split : ", active_time_split_process(iactive) + iactive = iactive + 1 + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" + endif + + end subroutine GFS_ccpp_scheme_sim_pre_init + + ! ###################################################################################### + ! + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run + ! + ! ###################################################################################### +!! \section arg_table_GFS_ccpp_scheme_sim_pre_run +!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! + subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, & + active_name, iactive_scheme_inloop, active_phys_tend, errmsg, errflg) + + ! Inputs + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, iactive_scheme_inloop + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:) :: dtend + character(len=16),intent(in), dimension(:) :: active_name + + ! Outputs + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: idtend, iactive + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Get tendency for "active" process. + + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. + ! + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + ! ###################################################################################### + if (active_name(iactive_scheme_inloop) == "LWRAD") iactive = index_of_process_longwave + if (active_name(iactive_scheme_inloop) == "SWRAD") iactive = index_of_process_shortwave + if (active_name(iactive_scheme_inloop) == "PBL") iactive = index_of_process_pbl + if (active_name(iactive_scheme_inloop) == "GWD") iactive = index_of_process_orographic_gwd + if (active_name(iactive_scheme_inloop) == "SCNV") iactive = index_of_process_scnv + if (active_name(iactive_scheme_inloop) == "DCNV") iactive = index_of_process_dcnv + if (active_name(iactive_scheme_inloop) == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp + + + end subroutine GFS_ccpp_scheme_sim_pre_run + +end module GFS_ccpp_scheme_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta new file mode 100644 index 000000000..cf7678fe6 --- /dev/null +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -0,0 +1,295 @@ +[ccpp-table-properties] + name = GFS_ccpp_scheme_sim_pre + type = scheme + dependencies = machine.F,module_ccpp_scheme_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_scheme_sim_pre_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[prc_LWRAD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_LWRAD + long_name = configuration for physics process in CCPP scheme simulator LWRAD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_SWRAD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SWRAD + long_name = configuration for physics process in CCPP scheme simulator SWRAD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_PBL_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_PBL + long_name = configuration for physics process in CCPP scheme simulator PBL + units = flag + dimensions = (3) + type = integer + intent = in +[prc_GWD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_GWD + long_name = configuration for physics process in CCPP scheme simulator GWD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_SCNV_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SCNV + long_name = configuration for physics process in CCPP scheme simulator SCNV + units = flag + dimensions = (3) + type = integer + intent = in +[prc_DCNV_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_DCNV + long_name = configuration for physics process in CCPP scheme simulator DCNV + units = flag + dimensions = (3) + type = integer + intent = in +[prc_cldMP_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_cldMP + long_name = configuration for physics process in CCPP scheme simulator cldMP + units = flag + dimensions = (3) + type = integer + intent = in +[nprg_active] + standard_name = number_of_prognostics_varaibles_in_CCPP_scheme_simulator + long_name = number of prognostic variables used in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in +[scheme_sim_data] + standard_name = filename_for_ccpp_scheme_simulator_data_file + long_name = filename for cccpp scheme simulator data file + units = none + dimensions = () + type = character + kind = len=256 + intent = in +[nprc_sim] + standard_name = number_of_physics_process_in_CCPP_scheme_simulator + long_name = number of physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = inout +[iactive_scheme] + standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = index of active physics schemes in CCPP scheme simulator + units = count + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = integer + intent = inout +[active_time_split_process] + standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator + long_name = flag to indicate if active physics schemes are time-split process + units = flag + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = logical + intent = inout +[physics_process] + standard_name = physics_process_type_for_CCPP_scheme_simulator + long_name = physics process type for CCPP scheme simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + type = base_physics_process + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_scheme_sim_pre_run + type = scheme +[iactive_scheme_inloop] + standard_name = count_for_active_scheme_in_CCPP_scheme_simulator + long_name = count for active physics scheme in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator + long_name = tendencies for active physics process in ccpp scheme simulator + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index f75580fb9..21f7bfde9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,93 +7,10 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - + use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none - - ! ######################################################################################## - ! Types used by the scheme simulator - ! ######################################################################################## - ! Type containing 1D (time) physics tendencies. - type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:), pointer :: q - end type phys_tend_1d - - ! Type containing 2D (lev,time) physics tendencies. - type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q - end type phys_tend_2d - - ! Type containing 3D (loc,lev,time) physics tendencies. - type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q - end type phys_tend_3d - - ! Type containing 4D (lon, lat,lev,time) physics tendencies. - type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q - end type phys_tend_4d - - ! This type contains the meta information and data for each physics process. - type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend_1d) :: tend1d - type(phys_tend_2d) :: tend2d - type(phys_tend_3d) :: tend3d - type(phys_tend_4d) :: tend4d - contains - generic, public :: linterp => linterp_1D, linterp_2D - procedure, private :: linterp_1D - procedure, private :: linterp_2D - procedure, public :: find_nearest_loc_2d_1d - procedure, public :: cmp_time_wts - end type base_physics_process - - ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process), dimension(:), allocatable :: & - physics_process - - ! Do not change these! - ! For time-split physics process we need to call this scheme twice in the SDF, once - ! before the "active" scheme is called, and once after. This is because the active - ! scheme uses an internal physics state that has been advanced forward by a subsequent - ! physics process(es). - integer :: nactive_proc - character(len=16),allocatable,dimension(:) :: active_name - integer,allocatable,dimension(:) :: iactive_scheme - logical,allocatable,dimension(:) :: active_time_split_process - integer :: iactive_scheme_inloop = 1 - - integer :: proc_start, proc_end - logical :: in_pre_active = .true. - logical :: in_post_active = .false. - - ! Set to true in data was loaded into "physics_process" - logical :: do_ccpp_scheme_simulator=.false. - public ccpp_scheme_simulator_run - contains ! ###################################################################################### @@ -104,42 +21,38 @@ module ccpp_scheme_simulator !! \section arg_table_ccpp_scheme_simulator_run !! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & - dtend, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & - dtdq_pbl, dtdq_mp, errmsg, errflg) + subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & + nactive_proc, proc_start, proc_end, active_name, iactive_scheme, physics_process, & + active_time_split_process, iactive_scheme_inloop, in_pre_active, in_post_active, & + tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, dtdq_pbl, dtdq_mp, & + errmsg, errflg) ! Inputs - integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind - integer, intent(in), dimension(8) :: jdat - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind_phys), intent(in), dimension(:,:,:) :: qgrs, dtend + logical, intent(in) :: do_ccpp_scheme_sim, active_time_split_process(:) + integer, intent(in) :: kdt, nCol, nLay, nactive_proc, jdat(8), & + iactive_scheme(:) + real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & + active_phys_tend(:,:,:) + character(len=16), intent(in) :: active_name(:) ! Outputs - real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:) :: gq0, dtdq_pbl, dtdq_mp - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg + type(base_physics_process),intent(inout) :: physics_process(:) + real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:), & + dtdq_pbl(:,:), dtdq_mp(:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: proc_start, proc_end, iactive_scheme_inloop + logical, intent(inout) :: in_pre_active, in_post_active ! Locals - integer :: iCol, iLay, nCol, nLay, idtend, year, month, day, hour, min, sec, iprc, & - index_of_active_process - real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt - real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt + integer :: iCol, year, month, day, hour, min, sec, iprc + real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_simulator) return + if (.not. do_ccpp_scheme_sim) return ! Current forecast time (Data-format specific) year = jdat(1) @@ -149,34 +62,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti min = jdat(6) sec = jdat(7) - ! Dimensions - nCol = size(gq0(:,1)) - nLay = size(gq0(1,:)) - - ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay)) - allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay)) - - ! Get tendency for "active" process. - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by the - ! physics schemes. Not all schemes output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option "fhzero". - ! For this to work, you need to clear the diagnostic buckets after each physics timestep when - ! running in the UFS/SCM. - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - if (active_name(iactive_scheme_inloop) == "LWRAD") index_of_active_process = index_of_process_longwave - if (active_name(iactive_scheme_inloop) == "SWRAD") index_of_active_process = index_of_process_shortwave - if (active_name(iactive_scheme_inloop) == "PBL") index_of_active_process = index_of_process_pbl - if (active_name(iactive_scheme_inloop) == "GWD") index_of_active_process = index_of_process_orographic_gwd - if (active_name(iactive_scheme_inloop) == "SCNV") index_of_active_process = index_of_process_scnv - if (active_name(iactive_scheme_inloop) == "DCNV") index_of_active_process = index_of_process_dcnv - if (active_name(iactive_scheme_inloop) == "cldMP") index_of_active_process = index_of_process_mp - ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) @@ -187,6 +72,9 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:) = 0. + ! + ! Set bookeeping indices + ! if (in_pre_active) then proc_start = 1 proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) @@ -196,22 +84,27 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti proc_end = size(physics_process) endif - ! Internal physics timestep evolution. + ! + ! Simulate internal physics timestep evolution. + ! do iprc = proc_start,proc_end - if (iprc == iactive_scheme(iactive_scheme_inloop)) then - print*,'Reached active process. ', iprc - else - print*,'Simulating ',iprc,' of ',proc_end - endif - do iCol = 1,nCol + ! Reset locals physics_process(iprc)%tend1d%T(:) = 0. physics_process(iprc)%tend1d%u(:) = 0. physics_process(iprc)%tend1d%v(:) = 0. physics_process(iprc)%tend1d%q(:) = 0. - ! Using scheme simulator (very simple, interpolate data tendency to local time) + ! Using scheme simulator + ! Very simple... + ! Interpolate 2D data (time,level) tendency to local time. + ! Here the data is already on the SCM vertical coordinate. + ! + ! In theory the data can be of any dimensionality and the onus falls on the + ! developer to extend the type "base_physics_process" to work with for their + ! application. + ! if (physics_process(iprc)%use_sim) then if (physics_process(iprc)%name == "LWRAD") then call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) @@ -236,24 +129,15 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti endif ! Using data tendency from "active" scheme(s). - ! DJS2023: This block is very ufs specific. See Note Above. else - idtend = dtidx(index_of_temperature,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%T = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(index_of_x_wind,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%u = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(index_of_y_wind,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(100+ntqv,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%q = dtend(iCol,:,idtend)/dtp + physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,1) + physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,2) + physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,3) + physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,4) endif - ! Update state now? + ! Update state now? (time-split scheme) if (physics_process(iprc)%time_split) then - print*,' time-split scheme...' gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp @@ -262,25 +146,31 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:) = 0. - ! Accumulate tendencies, update later? + ! Accumulate tendencies, update later? (process-split scheme) else - print*,' process-split scheme...' dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif + enddo ! END: Loop over columns + enddo ! END: Loop over physics processes + + ! + ! Update state with accumulated tendencies (process-split only) + ! + if (.not. physics_process(iprc)%time_split) then + do iCol = 1,nCol + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo - ! - do iLay=1,nLay - !write(*,'(i3,4f13.6)') ilay, gq0(iCol,iLay) , gq1(iCol,iLay) , dqdt(iCol,iLay)*dtp, physics_process(iprc)%tend1d%q(iLay)*dtp - enddo - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp - enddo + endif + ! + ! Update bookeeping indices + ! if (in_pre_active) then in_pre_active = .false. in_post_active = .true. @@ -296,224 +186,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti iactive_scheme_inloop = iactive_scheme_inloop + 1 endif - ! end subroutine ccpp_scheme_simulator_run - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: err_message - integer :: ti(1), tf(1) - real(kind_phys) :: w1, w2 - - ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) - end select - - end function linterp_1D - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] associated with - ! each location. - ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - real(kind_phys), intent(in) :: lon, lat - character(len=128) :: err_message - integer :: ti(1), tf(1), iNearest - real(kind_phys) :: w1, w2 - - ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ! Grab data tendency closest to column [lon,lat] - iNearest = this%find_nearest_loc_2d_1d(lon,lat) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) - end select - end function linterp_2D - - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### - pure function find_nearest_loc_2d_1d(this, lon, lat) - class(base_physics_process), intent(in) :: this - real(kind_phys), intent(in) :: lon, lat - integer :: find_nearest_loc_2d_1d - - find_nearest_loc_2d_1d = 1 - end function find_nearest_loc_2d_1d - - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) - ! Inputs - class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, sec - ! Outputs - integer,intent(out) :: ti(1), tf(1) - real(kind_phys),intent(out) :: w1, w2 - ! Locals - real(kind_phys) :: hrofday - - hrofday = hour*3600. + minute*60. + sec - ti = max(hour,1) - tf = min(ti + 1,24) - w1 = ((hour+1)*3600 - hrofday)/3600 - w2 = 1 - w1 - - end subroutine cmp_time_wts - - ! #################################################################################### - subroutine sim_LWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_LWRAD - - ! #################################################################################### - subroutine sim_SWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_SWRAD - - ! #################################################################################### - subroutine sim_GWD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - - end subroutine sim_GWD - - ! #################################################################################### - subroutine sim_PBL( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_PBL - - ! #################################################################################### - subroutine sim_DCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_DCNV - - ! #################################################################################### - subroutine sim_SCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_SCNV - - ! #################################################################################### - subroutine sim_cldMP( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - end subroutine sim_cldMP - end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 888ba2f8d..777d2248e 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,12 +1,18 @@ [ccpp-table-properties] name = ccpp_scheme_simulator type = scheme - dependencies = machine.F + dependencies = machine.F,module_ccpp_scheme_simulator.F90 -######################################################################## [ccpp-arg-table] name = ccpp_scheme_simulator_run type = scheme +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -14,6 +20,20 @@ dimensions = () type = integer intent = in +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in [dtp] standard_name = timestep_for_physics long_name = physics timestep @@ -29,6 +49,70 @@ dimensions = (8) type = integer intent = in +[nactive_proc] + standard_name = number_of_active_physics_process_in_CCPP_scheme_simulator + long_name = number of active physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[proc_start] + standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator + long_name = index for first physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[proc_end] + standard_name = index_for_last_physics_process_in_CCPP_scheme_simulator + long_name = index for last physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[iactive_scheme_inloop] + standard_name = count_for_active_scheme_in_CCPP_scheme_simulator + long_name = count for active physics scheme in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[in_pre_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme + long_name = flag to indicate location in physics process loop before active scheme + units = flag + dimensions = () + type = logical + intent = inout +[in_post_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme + long_name = flag to indicate location in physics process loop after active scheme + units = flag + dimensions = () + type = logical + intent = inout +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = in +[iactive_scheme] + standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = index of active physics schemes in CCPP scheme simulator + units = count + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = integer + intent = in +[active_time_split_process] + standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator + long_name = flag to indicate if active physics schemes are time-split process + units = flag + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = logical + intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -61,98 +145,14 @@ type = real kind = kind_phys intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator + long_name = tendencies for active physics process in ccpp scheme simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) type = real kind = kind_phys intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_longwave] - standard_name = index_of_longwave_heating_process_in_cumulative_change_index - long_name = index of longwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_shortwave] - standard_name = index_of_shortwave_heating_process_in_cumulative_change_index - long_name = index of shortwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_pbl] - standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index - long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_mp] - standard_name = index_of_microphysics_process_process_in_cumulative_change_index - long_name = index of microphysics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in [gt0] standard_name = air_temperature_of_new_state long_name = temperature updated by physics @@ -201,6 +201,13 @@ type = real kind = kind_phys intent = inout +[physics_process] + standard_name = physics_process_type_for_CCPP_scheme_simulator + long_name = physics process type for CCPP scheme simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + type = base_physics_process + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 new file mode 100644 index 000000000..a0756ab61 --- /dev/null +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -0,0 +1,302 @@ +! ######################################################################################## +! +! This module contains the type, base_physics_process, and supporting subroutines needed +! by the ccpp scheme simulator. +! +! ######################################################################################## +module module_ccpp_scheme_simulator +!> \section arg_table_module_ccpp_scheme_simulator Argument table +!! \htmlinclude module_ccpp_scheme_simulator.html +!! + use machine, only : kind_phys + implicit none + + public base_physics_process + + ! Type containing 1D (time) physics tendencies. + type phys_tend_1d + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:), pointer :: q + end type phys_tend_1d + + ! Type containing 2D (lev,time) physics tendencies. + type phys_tend_2d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q + end type phys_tend_2d + + ! Type containing 3D (loc,lev,time) physics tendencies. + type phys_tend_3d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q + end type phys_tend_3d + + ! Type containing 4D (lon, lat,lev,time) physics tendencies. + type phys_tend_4d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q + end type phys_tend_4d + +! This type contains the meta information and data for each physics process. + +!> \section arg_table_base_physics_process Argument Table +!! \htmlinclude base_physics_process.html +!! + type base_physics_process + character(len=16) :: name + logical :: time_split = .false. + logical :: use_sim = .false. + integer :: order + type(phys_tend_1d) :: tend1d + type(phys_tend_2d) :: tend2d + type(phys_tend_3d) :: tend3d + type(phys_tend_4d) :: tend4d + contains + generic, public :: linterp => linterp_1D, linterp_2D + procedure, private :: linterp_1D + procedure, private :: linterp_2D + procedure, public :: find_nearest_loc_2d_1d + procedure, public :: cmp_time_wts + end type base_physics_process + +contains + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. + ! #################################################################################### + function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: err_message + integer :: ti(1), tf(1) + real(kind_phys) :: w1, w2 + + ! Interpolation weights + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + case("q") + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + end select + + end function linterp_1D + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. + ! This assumes that the location dimension has a [longitude, latitude] associated with + ! each location. + ! #################################################################################### + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + real(kind_phys), intent(in) :: lon, lat + character(len=128) :: err_message + integer :: ti(1), tf(1), iNearest + real(kind_phys) :: w1, w2 + + ! Interpolation weights (temporal) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + ! Grab data tendency closest to column [lon,lat] + iNearest = this%find_nearest_loc_2d_1d(lon,lat) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) + case("q") + this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) + end select + end function linterp_2D + + ! #################################################################################### + ! Type-bound procedure to find nearest location. + ! For use with linterp_2D, NOT YET IMPLEMENTED. + ! #################################################################################### + pure function find_nearest_loc_2d_1d(this, lon, lat) + class(base_physics_process), intent(in) :: this + real(kind_phys), intent(in) :: lon, lat + integer :: find_nearest_loc_2d_1d + + find_nearest_loc_2d_1d = 1 + end function find_nearest_loc_2d_1d + + ! #################################################################################### + ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) + ! forcing. + ! #################################################################################### + subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) + ! Inputs + class(base_physics_process), intent(in) :: this + integer, intent(in) :: year, month, day, hour, minute, sec + ! Outputs + integer,intent(out) :: ti(1), tf(1) + real(kind_phys),intent(out) :: w1, w2 + ! Locals + real(kind_phys) :: hrofday + + hrofday = hour*3600. + minute*60. + sec + ti = max(hour,1) + tf = min(ti + 1,24) + w1 = ((hour+1)*3600 - hrofday)/3600 + w2 = 1 - w1 + + end subroutine cmp_time_wts + + ! #################################################################################### + ! #################################################################################### + subroutine sim_LWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_LWRAD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_SWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_SWRAD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_GWD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + + end subroutine sim_GWD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_PBL( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_PBL + + ! #################################################################################### + ! #################################################################################### + subroutine sim_DCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_DCNV + + ! #################################################################################### + ! #################################################################################### + subroutine sim_SCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_SCNV + + ! #################################################################################### + ! #################################################################################### + subroutine sim_cldMP( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + end subroutine sim_cldMP + +end module module_ccpp_scheme_simulator diff --git a/physics/module_ccpp_scheme_simulator.meta b/physics/module_ccpp_scheme_simulator.meta new file mode 100644 index 000000000..8eefb228c --- /dev/null +++ b/physics/module_ccpp_scheme_simulator.meta @@ -0,0 +1,24 @@ +[ccpp-table-properties] + name = base_physics_process + type = ddt + dependencies = + +[ccpp-arg-table] + name = base_physics_process + type = ddt + +######################################################################## +[ccpp-table-properties] + name = module_ccpp_scheme_simulator + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = module_ccpp_scheme_simulator + type = module +[base_physics_process] + standard_name = base_physics_process + long_name = definition of type base_physics_process + units = DDT + dimensions = () + type = base_physics_process From 5d49f7942f4863441cc2678844a7b744952c9006 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 1 Jun 2023 13:48:56 -0600 Subject: [PATCH 021/122] Reorganization of scheme simulator. Now stateless. --- physics/GFS_ccpp_scheme_sim_pre.F90 | 745 ++++++++--------------- physics/GFS_ccpp_scheme_sim_pre.meta | 158 +---- physics/ccpp_scheme_simulator.F90 | 26 +- physics/ccpp_scheme_simulator.meta | 52 -- physics/load_ccpp_scheme_sim.F90 | 588 ------------------ physics/load_ccpp_scheme_sim.meta | 60 -- physics/module_ccpp_scheme_simulator.F90 | 111 ++-- 7 files changed, 334 insertions(+), 1406 deletions(-) delete mode 100644 physics/load_ccpp_scheme_sim.F90 delete mode 100644 physics/load_ccpp_scheme_sim.meta diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index acd0c6692..31bafff01 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -1,391 +1,222 @@ ! ######################################################################################## ! ! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. -! ) _init: read and load data into type used by ccpp_scheme_simulator -! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! ) load: read and load data into type used by ccpp_scheme_simulator +! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator ! ! ######################################################################################## module GFS_ccpp_scheme_sim_pre use machine, only: kind_phys - use netcdf use module_ccpp_scheme_simulator, only: base_physics_process -#ifdef MPI - use mpi -#endif + use netcdf implicit none - - public GFS_ccpp_scheme_sim_pre_init, GFS_ccpp_scheme_sim_pre_run + public GFS_ccpp_scheme_sim_pre_run, load_ccpp_scheme_sim contains ! ###################################################################################### ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_init + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run ! ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_init -!! \htmlinclude GFS_ccpp_scheme_sim_pre_init.html -!! - subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_scheme_sim, & - scheme_sim_data, nprg_active, nprc_sim, prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg,& - prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg, active_name, & - iactive_scheme, active_time_split_process, physics_process, errmsg, errflg) +!! \section arg_table_GFS_ccpp_scheme_sim_pre_run +!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! + subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, active_phys_tend, errmsg, errflg) ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nprg_active, nprc_sim - logical, intent (in) :: do_ccpp_scheme_sim - character(len=256), intent (in) :: scheme_sim_data - integer, dimension(3), intent (in) :: prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, & - prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:) :: dtend + type(base_physics_process),intent(in) :: physics_process(:) ! Outputs - type(base_physics_process),intent(inout) :: physics_process(:) - character(len=16),intent(inout) :: active_name(:) - integer, intent(inout) :: iactive_scheme(:) - logical, intent(inout) :: active_time_split_process(:) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive - logical :: exists - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + ! Locals + integer :: idtend, iactive ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return - + ! Get tendency for "active" process. + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. ! - ! Part A) Read in data. + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 ! ! ###################################################################################### - - ! Check that input data file exists - inquire (file = trim (scheme_sim_data), exist = exists) + if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave + if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave + if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl + if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd + if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv + if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv + if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp + + + end subroutine GFS_ccpp_scheme_sim_pre_run + + ! ###################################################################################### + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, & + errmsg, errflg) + + ! Inputs + integer, intent (in) :: nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + type(base_physics_process),intent(inout),allocatable :: physics_process(:) + integer, intent(out) :: nprg_active + integer, intent(out) :: errflg + character(len=256), intent(out) :: errmsg + + ! Local variables + integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data + character(len=256) :: scheme_sim_file + logical :: exists, do_ccpp_scheme_sim + integer :: nprc_sim + + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + prc_LWRAD_cfg = (/0,0,0/), & + prc_SWRAD_cfg = (/0,0,0/), & + prc_PBL_cfg = (/0,0,0/), & + prc_GWD_cfg = (/0,0,0/), & + prc_SCNV_cfg = (/0,0,0/), & + prc_DCNV_cfg = (/0,0,0/), & + prc_cldMP_cfg = (/0,0,0/) + + ! Namelist + namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + prc_DCNV_cfg, prc_cldMP_cfg + + errmsg = '' + errflg = 0 + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not exist' + errmsg = 'CCPP scheme simulator namelist file: '//trim(nml_file)//' does not exist.' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = ccpp_scheme_sim_nml, iostat=status) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (prc_SWRAD_cfg(1) .or. prc_LWRAD_cfg(1) .or. prc_PBL_cfg(1) .or. & + prc_GWD_cfg(1) .or. prc_SCNV_cfg(1) .or. prc_DCNV_cfg(1) .or. & + prc_cldMP_cfg(1)) then + else + return + endif + + ! Check that input data file exists. + inquire (file = trim (scheme_sim_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not exist' errflg = 1 return endif - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif + ! + ! Read data file... + ! - ! Open file (required) - status = nf90_open(trim(scheme_sim_data), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(scheme_sim_data) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast dimensions... - ! (ALL processors) - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! - ! What data fields do we have? - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) - - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) + ! Open file + status = nf90_open(trim(scheme_sim_file), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in CCPP scheme simulator file: '//trim(scheme_sim_file) + errflg = 1 + return + endif + + ! Metadata (dimensions) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [time] dimension' + errflg = 1 + return + endif + + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [lev] dimension' + errflg = 1 + return + endif + + ! Allocate space and read in data + allocate(physics_process(nprc_sim)) + physics_process(1)%active_name = '' + physics_process(1)%iactive_scheme = 0 + physics_process(1)%active_tsp = .false. + do iprc = 1,nprc_sim + allocate(physics_process(iprc)%tend1d%T( nlev_data )) + allocate(physics_process(iprc)%tend1d%u( nlev_data )) + allocate(physics_process(iprc)%tend1d%v( nlev_data )) + allocate(physics_process(iprc)%tend1d%q( nlev_data )) + allocate(physics_process(iprc)%tend2d%time( ntime_data)) + allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) + + ! Temporal info status = nf90_inq_varid(ncid, 'times', varID) if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) + status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain times variable' + errmsg = 'SCM data tendency file: '//trim(scheme_sim_file)//' does not contain times variable' errflg = 1 return endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) - -#ifdef MPI - endif ! Master process - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast data... - ! (ALL processors) - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Part B) Populate physics_process type. - ! - ! ####################################################################################### - ! Metadata - do iprc = 1,nprc_sim if (iprc == prc_SWRAD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" if (prc_SWRAD_cfg(1) == 1) then @@ -394,8 +225,14 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_SWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + nprg_active = 1 endif + if (iprc == prc_LWRAD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "LWRAD" if (prc_LWRAD_cfg(1) == 1) then @@ -404,8 +241,14 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_LWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + nprg_active =1 endif + if (iprc == prc_GWD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "GWD" if (prc_GWD_cfg(1) == 1) then @@ -414,8 +257,18 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_GWD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + nprg_active = 3 endif + if (iprc == prc_PBL_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "PBL" if (prc_PBL_cfg(1) == 1) then @@ -424,8 +277,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_PBL_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + nprg_active = 4 endif + if (iprc == prc_SCNV_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "SCNV" if (prc_SCNV_cfg(1) == 1) then @@ -434,8 +299,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_SCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 4 endif + if (iprc == prc_DCNV_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "DCNV" if (prc_DCNV_cfg(1) == 1) then @@ -444,8 +321,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_DCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 4 endif + if (iprc == prc_cldMP_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "cldMP" if (prc_cldMP_cfg(1) == 1) then @@ -454,150 +343,48 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_cldMP_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 2 endif - enddo - ! Load data - physics_process(prc_LWRAD_cfg(3))%tend2d%time => time_data - physics_process(prc_SWRAD_cfg(3))%tend2d%time => time_data - physics_process(prc_PBL_cfg(3))%tend2d%time => time_data - physics_process(prc_GWD_cfg(3))%tend2d%time => time_data - physics_process(prc_DCNV_cfg(3))%tend2d%time => time_data - physics_process(prc_SCNV_cfg(3))%tend2d%time => time_data - physics_process(prc_cldMP_cfg(3))%tend2d%time => time_data - if (have_dTdt_LWRAD_data) physics_process(prc_SWRAD_cfg(3))%tend2d%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(prc_LWRAD_cfg(3))%tend2d%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%q => dqdt_cldMP_data - - ! Which process-scheme(s) is(are) "Active"? Are they time-split process? - iactive = 0 - active_time_split_process(:) = .false. - do iprc = 1,nprc_sim + ! Which process-scheme is "active"? Is process time-split? if (.not. physics_process(iprc)%use_sim) then - iactive = iactive + 1 - iactive_scheme(iactive) = iprc - active_name(iactive) = physics_process(iprc)%name + physics_process(1)%iactive_scheme = iprc + physics_process(1)%active_name = physics_process(iprc)%name if (physics_process(iprc)%time_split) then - active_time_split_process(iactive) = .true. + physics_process(1)%active_tsp = .true. endif endif + enddo - ! - if (mpirank .eq. mpiroot) then - print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" - print*, "-----------------------------------" - iactive = 1 - do iprc = 1,nprc_sim - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_scheme: ", trim(active_name(iactive)) - print*, " order: ", physics_process(iactive_scheme(iactive))%order - print*, " time_split : ", active_time_split_process(iactive) - iactive = iactive + 1 - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" + if (physics_process(1)%iactive_scheme == 0) then + errflg = 1 + errmsg = "ERROR: No active scheme set for CCPP scheme simulator" + return endif - end subroutine GFS_ccpp_scheme_sim_pre_init - - ! ###################################################################################### - ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run - ! - ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_run -!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html -!! - subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, & - active_name, iactive_scheme_inloop, active_phys_tend, errmsg, errflg) - - ! Inputs - integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, iactive_scheme_inloop - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:,:) :: dtend - character(len=16),intent(in), dimension(:) :: active_name - - ! Outputs - real(kind_phys), intent(out) :: active_phys_tend(:,:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: idtend, iactive - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Get tendency for "active" process. - - ! ###################################################################################### - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics schemes. Not all schemes output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some - ! interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option - ! "fhzero". For this to work, you need to clear the diagnostic buckets after each - ! physics timestep when running in the UFS/SCM. - ! - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - ! ###################################################################################### - if (active_name(iactive_scheme_inloop) == "LWRAD") iactive = index_of_process_longwave - if (active_name(iactive_scheme_inloop) == "SWRAD") iactive = index_of_process_shortwave - if (active_name(iactive_scheme_inloop) == "PBL") iactive = index_of_process_pbl - if (active_name(iactive_scheme_inloop) == "GWD") iactive = index_of_process_orographic_gwd - if (active_name(iactive_scheme_inloop) == "SCNV") iactive = index_of_process_scnv - if (active_name(iactive_scheme_inloop) == "DCNV") iactive = index_of_process_dcnv - if (active_name(iactive_scheme_inloop) == "cldMP") iactive = index_of_process_mp - - ! Heat - idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp - ! u-wind - idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp - ! v-wind - idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp - ! Moisture - idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp - + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(physics_process(1)%active_name) + print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order + print*, " time_split : ", physics_process(1)%active_tsp + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" - end subroutine GFS_ccpp_scheme_sim_pre_run + end subroutine load_ccpp_scheme_sim end module GFS_ccpp_scheme_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index cf7678fe6..e101e4650 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -5,170 +5,14 @@ ######################################################################## [ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_init + name = GFS_ccpp_scheme_sim_pre_run type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[prc_LWRAD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_LWRAD - long_name = configuration for physics process in CCPP scheme simulator LWRAD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_SWRAD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SWRAD - long_name = configuration for physics process in CCPP scheme simulator SWRAD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_PBL_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_PBL - long_name = configuration for physics process in CCPP scheme simulator PBL - units = flag - dimensions = (3) - type = integer - intent = in -[prc_GWD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_GWD - long_name = configuration for physics process in CCPP scheme simulator GWD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_SCNV_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SCNV - long_name = configuration for physics process in CCPP scheme simulator SCNV - units = flag - dimensions = (3) - type = integer - intent = in -[prc_DCNV_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_DCNV - long_name = configuration for physics process in CCPP scheme simulator DCNV - units = flag - dimensions = (3) - type = integer - intent = in -[prc_cldMP_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_cldMP - long_name = configuration for physics process in CCPP scheme simulator cldMP - units = flag - dimensions = (3) - type = integer - intent = in -[nprg_active] - standard_name = number_of_prognostics_varaibles_in_CCPP_scheme_simulator - long_name = number of prognostic variables used in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator - units = flag - dimensions = () - type = logical - intent = in -[scheme_sim_data] - standard_name = filename_for_ccpp_scheme_simulator_data_file - long_name = filename for cccpp scheme simulator data file - units = none - dimensions = () - type = character - kind = len=256 - intent = in -[nprc_sim] - standard_name = number_of_physics_process_in_CCPP_scheme_simulator - long_name = number of physics process in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 - intent = inout -[iactive_scheme] - standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = index of active physics schemes in CCPP scheme simulator - units = count - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = integer - intent = inout -[active_time_split_process] - standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator - long_name = flag to indicate if active physics schemes are time-split process - units = flag - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = logical - intent = inout [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator units = mixed dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) type = base_physics_process - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_run - type = scheme -[iactive_scheme_inloop] - standard_name = count_for_active_scheme_in_CCPP_scheme_simulator - long_name = count for active physics scheme in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 intent = in [dtend] standard_name = cumulative_change_of_state_variables diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 21f7bfde9..e4348599f 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -22,26 +22,21 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_run.html !! subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & - nactive_proc, proc_start, proc_end, active_name, iactive_scheme, physics_process, & - active_time_split_process, iactive_scheme_inloop, in_pre_active, in_post_active, & - tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, dtdq_pbl, dtdq_mp, & - errmsg, errflg) + proc_start, proc_end, physics_process, in_pre_active, in_post_active, tgrs, ugrs, & + vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim, active_time_split_process(:) - integer, intent(in) :: kdt, nCol, nLay, nactive_proc, jdat(8), & - iactive_scheme(:) + logical, intent(in) :: do_ccpp_scheme_sim + integer, intent(in) :: kdt, nCol, nLay, jdat(8) real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & active_phys_tend(:,:,:) - character(len=16), intent(in) :: active_name(:) ! Outputs type(base_physics_process),intent(inout) :: physics_process(:) - real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:), & - dtdq_pbl(:,:), dtdq_mp(:,:) + real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg - integer, intent(inout) :: proc_start, proc_end, iactive_scheme_inloop + integer, intent(inout) :: proc_start, proc_end logical, intent(inout) :: in_pre_active, in_post_active ! Locals @@ -77,10 +72,10 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j ! if (in_pre_active) then proc_start = 1 - proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) + proc_end = max(1,physics_process(1)%iactive_scheme-1) endif if (in_post_active) then - proc_start = iactive_scheme(iactive_scheme_inloop) + proc_start = physics_process(1)%iactive_scheme proc_end = size(physics_process) endif @@ -179,11 +174,6 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j if (size(physics_process)+1 == iprc) then in_pre_active = .true. in_post_active = .false. - iactive_scheme_inloop = 1 - endif - - if (iactive_scheme_inloop < nactive_proc) then - iactive_scheme_inloop = iactive_scheme_inloop + 1 endif end subroutine ccpp_scheme_simulator_run diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 777d2248e..8b2618317 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -49,13 +49,6 @@ dimensions = (8) type = integer intent = in -[nactive_proc] - standard_name = number_of_active_physics_process_in_CCPP_scheme_simulator - long_name = number of active physics process in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in [proc_start] standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator long_name = index for first physics process in CCPP scheme simulator @@ -70,13 +63,6 @@ dimensions = () type = integer intent = inout -[iactive_scheme_inloop] - standard_name = count_for_active_scheme_in_CCPP_scheme_simulator - long_name = count for active physics scheme in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = inout [in_pre_active] standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme long_name = flag to indicate location in physics process loop before active scheme @@ -91,28 +77,6 @@ dimensions = () type = logical intent = inout -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 - intent = in -[iactive_scheme] - standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = index of active physics schemes in CCPP scheme simulator - units = count - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = integer - intent = in -[active_time_split_process] - standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator - long_name = flag to indicate if active physics schemes are time-split process - units = flag - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = logical - intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -185,22 +149,6 @@ type = real kind = kind_phys intent = inout -[dtdq_pbl] - standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL - long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdq_mp] - standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics - long_name = moisture tendency due to microphysics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 deleted file mode 100644 index 1fb3dc983..000000000 --- a/physics/load_ccpp_scheme_sim.F90 +++ /dev/null @@ -1,588 +0,0 @@ -! ######################################################################################## -! -! CCPP scheme to read and load data for ccpp_scheme_simulator -! -! ######################################################################################## -module load_ccpp_scheme_sim - use machine, only: kind_phys - use netcdf - use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, active_time_split_process, nactive_proc -#ifdef MPI - use mpi -#endif - implicit none - - ! ######################################################################################## - ! - ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to - ! populate "physics_process" type array, defined in ccpp_scheme_simulator.F90 - ! - ! ######################################################################################## - - ! Number of physics process (set in namelist) - integer :: nPhysProcess - - ! For each process there is a corresponding namelist entry, which is constructed as follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - proc_LWRAD_config = (/0,0,0/), & - proc_SWRAD_config = (/0,0,0/), & - proc_PBL_config = (/0,0,0/), & - proc_GWD_config = (/0,0,0/), & - proc_SCNV_config = (/0,0,0/), & - proc_DCNV_config = (/0,0,0/), & - proc_cldMP_config = (/0,0,0/) - - ! Activation flag for scheme. - logical :: do_load_ccpp_scheme = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data - - ! Scheme initialization flag. - logical :: module_initialized = .false. - - public load_ccpp_scheme_sim_init -contains - - ! ###################################################################################### - ! - ! SUBROUTINE load_ccpp_scheme_sim_init - ! - ! ###################################################################################### -!! \section arg_table_load_ccpp_scheme_sim_init -!! \htmlinclude load_ccpp_scheme_sim_init.html -!! - subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - errmsg, errflg) - - ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive - character(len=256) :: fileIN - logical :: exists - integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Namelist - namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & - proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & - proc_cldMP_config - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (module_initialized) return - module_initialized = .true. - - ! ###################################################################################### - ! - ! Part A) Read in namelist and data. - ! - ! ###################################################################################### - - ! Read in namelist - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = scm_data_nml, iostat=status) - close (nlunit) - - ! Only proceed if scheme simulator requested. - if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & - proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & - proc_cldMP_config(1)) then - do_ccpp_scheme_simulator = .true. - else - return - endif - - ! Check that input data file exists - inquire (file = trim (fileIN), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif - - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast dimensions... - ! (ALL processors) - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! - ! What data fields do we have? - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) - - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - print*,'dTdt_SWRAD_data: ',dTdt_SWRAD_data - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) - -#ifdef MPI - endif ! Master process - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast data... - ! (ALL processors) - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Part B) Populate physics_process type. - ! - ! ####################################################################################### - - ! Allocate - allocate(physics_process(nPhysProcess)) - - ! Metadata - do iprc = 1,nPhysProcess - allocate(physics_process(iprc)%tend1d%T(nlev_data)) - allocate(physics_process(iprc)%tend1d%u(nlev_data)) - allocate(physics_process(iprc)%tend1d%v(nlev_data)) - allocate(physics_process(iprc)%tend1d%q(nlev_data)) - if (iprc == proc_SWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (proc_SWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_LWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (proc_LWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_LWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_GWD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (proc_GWD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_GWD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_PBL_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (proc_PBL_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_PBL_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_SCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (proc_SCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_DCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (proc_DCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_DCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_cldMP_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (proc_cldMP_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_cldMP_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - enddo - - ! Load data - physics_process(proc_LWRAD_config(3))%tend2d%time => time_data - physics_process(proc_SWRAD_config(3))%tend2d%time => time_data - physics_process(proc_PBL_config(3))%tend2d%time => time_data - physics_process(proc_GWD_config(3))%tend2d%time => time_data - physics_process(proc_DCNV_config(3))%tend2d%time => time_data - physics_process(proc_SCNV_config(3))%tend2d%time => time_data - physics_process(proc_cldMP_config(3))%tend2d%time => time_data - if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend2d%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend2d%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data - - ! How many active schemes are there? - nactive_proc = 0 - iactive = 0 - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) nactive_proc = nactive_proc + 1 - enddo - allocate(iactive_scheme(nactive_proc),active_name(nactive_proc),active_time_split_process(nactive_proc)) - - ! Which process-scheme(s) is(are) "Active"? Are they time-split process? - active_time_split_process(:) = .false. - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) then - iactive = iactive + 1 - iactive_scheme(iactive) = iprc - active_name(iactive) = physics_process(iprc)%name - if (physics_process(iprc)%time_split) then - active_time_split_process(iactive) = .true. - endif - endif - enddo - - ! - if (mpirank .eq. mpiroot) then - print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" - print*, "-----------------------------------" - iactive = 1 - do iprc = 1,nPhysProcess - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_scheme: ", trim(active_name(iactive)) - print*, " order: ", physics_process(iactive_scheme(iactive))%order - print*, " time_split : ", active_time_split_process(iactive) - iactive = iactive + 1 - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" - endif - - end subroutine load_ccpp_scheme_sim_init - -end module load_ccpp_scheme_sim diff --git a/physics/load_ccpp_scheme_sim.meta b/physics/load_ccpp_scheme_sim.meta deleted file mode 100644 index 6e0aea925..000000000 --- a/physics/load_ccpp_scheme_sim.meta +++ /dev/null @@ -1,60 +0,0 @@ -[ccpp-table-properties] - name = load_ccpp_scheme_sim - type = scheme - dependencies = machine.F,ccpp_scheme_simulator.F90 - -######################################################################## -[ccpp-arg-table] - name = load_ccpp_scheme_sim_init - type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[nlunit] - standard_name = iounit_of_namelist - long_name = fortran unit number for opening nameliust file - units = none - dimensions = () - type = integer - intent = in -[nml_file] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - dimensions = () - type = character - kind = len=* - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 index a0756ab61..695a2bb03 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -15,41 +15,45 @@ module module_ccpp_scheme_simulator ! Type containing 1D (time) physics tendencies. type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:), pointer :: q + real(kind_phys), dimension(:), allocatable :: T + real(kind_phys), dimension(:), allocatable :: u + real(kind_phys), dimension(:), allocatable :: v + real(kind_phys), dimension(:), allocatable :: q + real(kind_phys), dimension(:), allocatable :: p + real(kind_phys), dimension(:), allocatable :: z end type phys_tend_1d ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: T + real(kind_phys), dimension(:,:), allocatable :: u + real(kind_phys), dimension(:,:), allocatable :: v + real(kind_phys), dimension(:,:), allocatable :: q + real(kind_phys), dimension(:,:), allocatable :: p + real(kind_phys), dimension(:,:), allocatable :: z end type phys_tend_2d ! Type containing 3D (loc,lev,time) physics tendencies. type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:), allocatable :: lon + real(kind_phys), dimension(:), allocatable :: lat + real(kind_phys), dimension(:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:), allocatable :: q end type phys_tend_3d - ! Type containing 4D (lon, lat,lev,time) physics tendencies. + ! Type containing 4D (lon,lat,lev,time) physics tendencies. type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: lon + real(kind_phys), dimension(:,:), allocatable :: lat + real(kind_phys), dimension(:,:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:,:), allocatable :: q end type phys_tend_4d ! This type contains the meta information and data for each physics process. @@ -58,14 +62,17 @@ module module_ccpp_scheme_simulator !! \htmlinclude base_physics_process.html !! type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend_1d) :: tend1d - type(phys_tend_2d) :: tend2d - type(phys_tend_3d) :: tend3d - type(phys_tend_4d) :: tend4d + character(len=16) :: name ! Physics process name + logical :: time_split = .false. ! Is process time-split? + logical :: use_sim = .false. ! Is process "active"? + integer :: order ! Order of process in process-loop + type(phys_tend_1d) :: tend1d ! Instantaneous data + type(phys_tend_2d) :: tend2d ! 2-dimensional data + type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. + type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. + character(len=16) :: active_name ! "Active" scheme: Physics process name + integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop + logical :: active_tsp ! "Active" scheme: Is process time-split? contains generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D @@ -109,7 +116,7 @@ end function linterp_1D ! Type-bound procedure to compute tendency profile for time-of-day. ! ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] associated with + ! This assumes that the location dimension has a [longitude, latitude] allocated with ! each location. ! #################################################################################### function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) @@ -180,7 +187,7 @@ subroutine sim_LWRAD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif @@ -193,7 +200,7 @@ subroutine sim_SWRAD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif @@ -206,13 +213,13 @@ subroutine sim_GWD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif @@ -225,16 +232,16 @@ subroutine sim_PBL( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -247,16 +254,16 @@ subroutine sim_DCNV( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -269,16 +276,16 @@ subroutine sim_SCNV( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -291,10 +298,10 @@ subroutine sim_cldMP( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif end subroutine sim_cldMP From 4d691081e46d17d5b77b6aa7714ba2a369088ae4 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 14 Jun 2023 14:25:38 -0400 Subject: [PATCH 022/122] fix bug in scm_sfc_flux_spec.F90 --- physics/scm_sfc_flux_spec.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index 835b468ff..e835b77ff 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:) + integer, intent(inout) :: islmsk(:), use_lake_model(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) From 12d4fc22128d7267fb6a8563a94bb579d27d2127 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 7 Jul 2023 12:16:54 -0600 Subject: [PATCH 023/122] Working as expected! --- physics/GFS_ccpp_scheme_sim_pre.F90 | 77 ++++++++++++++++++------ physics/GFS_ccpp_scheme_sim_pre.meta | 28 +++++++++ physics/ccpp_scheme_simulator.F90 | 47 ++++++++++----- physics/ccpp_scheme_simulator.meta | 28 +++++++++ physics/module_ccpp_scheme_simulator.F90 | 1 + 5 files changed, 150 insertions(+), 31 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index 31bafff01..a5f6f0cfa 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -24,8 +24,8 @@ module GFS_ccpp_scheme_sim_pre subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, & - physics_process, active_phys_tend, errmsg, errflg) + index_of_temperature, index_of_x_wind, index_of_y_wind, physics_process, & + iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, errmsg, errflg) ! Inputs integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & @@ -36,6 +36,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in), dimension(:,:,:) :: dtend type(base_physics_process),intent(in) :: physics_process(:) + integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q ! Outputs real(kind_phys), intent(out) :: active_phys_tend(:,:,:) @@ -76,23 +77,33 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process ! Heat idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp + endif + ! u-wind idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp + endif + ! v-wind idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp + endif + ! Moisture idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp - + if (idtend >= 1) then + active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp + endif end subroutine GFS_ccpp_scheme_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, & - errmsg, errflg) + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & + iactive_T, iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs integer, intent (in) :: nlunit @@ -100,7 +111,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, ! Outputs type(base_physics_process),intent(inout),allocatable :: physics_process(:) - integer, intent(out) :: nprg_active + integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q integer, intent(out) :: errflg character(len=256), intent(out) :: errmsg @@ -221,14 +232,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "SWRAD" if (prc_SWRAD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 endif if (prc_SWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - nprg_active = 1 endif if (iprc == prc_LWRAD_cfg(3)) then @@ -237,14 +251,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "LWRAD" if (prc_LWRAD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 endif if (prc_LWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - nprg_active =1 endif if (iprc == prc_GWD_cfg(3)) then @@ -253,10 +270,16 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "GWD" if (prc_GWD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 3 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 endif if (prc_GWD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -264,7 +287,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - nprg_active = 3 endif if (iprc == prc_PBL_cfg(3)) then @@ -273,10 +295,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "PBL" if (prc_PBL_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_PBL_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -286,7 +315,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - nprg_active = 4 endif if (iprc == prc_SCNV_cfg(3)) then @@ -295,10 +323,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "SCNV" if (prc_SCNV_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_SCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -308,7 +343,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 4 endif if (iprc == prc_DCNV_cfg(3)) then @@ -317,6 +351,12 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "DCNV" if (prc_DCNV_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_DCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. @@ -330,7 +370,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 4 endif if (iprc == prc_cldMP_cfg(3)) then @@ -339,16 +378,20 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "cldMP" if (prc_cldMP_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 2 + iactive_T = 1 + iactive_q = 2 endif if (prc_cldMP_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 2 endif ! Which process-scheme is "active"? Is process time-split? diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index e101e4650..682b4baf8 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -122,6 +122,34 @@ type = real kind = kind_phys intent = out +[iactive_T] + standard_name = index_for_active_T_in_CCPP_scheme_simulator + long_name = index into active process tracer array for temperature in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_scheme_simulator + long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_scheme_simulator + long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_scheme_simulator + long_name = index into active process tracer array for moisture in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index e4348599f..b825b8403 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,7 +7,7 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none public ccpp_scheme_simulator_run @@ -22,15 +22,16 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_run.html !! subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & - proc_start, proc_end, physics_process, in_pre_active, in_post_active, tgrs, ugrs, & - vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, errmsg, errflg) + iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& + in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& + gv0, gq0, errmsg, errflg) ! Inputs logical, intent(in) :: do_ccpp_scheme_sim - integer, intent(in) :: kdt, nCol, nLay, jdat(8) + integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & + iactive_v, iactive_q real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & active_phys_tend(:,:,:) - ! Outputs type(base_physics_process),intent(inout) :: physics_process(:) real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) @@ -125,18 +126,18 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j ! Using data tendency from "active" scheme(s). else - physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,1) - physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,2) - physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,3) - physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,4) + if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) + if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) + if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) + if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) endif ! Update state now? (time-split scheme) if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. @@ -149,11 +150,29 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif enddo ! END: Loop over columns + + ! Print diagnostics + if (physics_process(iprc)%use_sim) then + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' + endif + else + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' time split scheme (active)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' process split scheme (active)' + endif + write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active + endif enddo ! END: Loop over physics processes ! ! Update state with accumulated tendencies (process-split only) + ! (Suites where active scheme is last physical process) ! + iprc = minval([iprc,proc_end]) if (.not. physics_process(iprc)%time_split) then do iCol = 1,nCol gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp @@ -171,7 +190,7 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j in_post_active = .true. endif - if (size(physics_process)+1 == iprc) then + if (size(physics_process) == proc_end) then in_pre_active = .true. in_post_active = .false. endif diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 8b2618317..c60cd9a38 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -117,6 +117,34 @@ type = real kind = kind_phys intent = in +[iactive_T] + standard_name = index_for_active_T_in_CCPP_scheme_simulator + long_name = index into active process tracer array for temperature in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_scheme_simulator + long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_scheme_simulator + long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_scheme_simulator + long_name = index into active process tracer array for moisture in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in [gt0] standard_name = air_temperature_of_new_state long_name = temperature updated by physics diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 index 695a2bb03..a122563d9 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -73,6 +73,7 @@ module module_ccpp_scheme_simulator character(len=16) :: active_name ! "Active" scheme: Physics process name integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop logical :: active_tsp ! "Active" scheme: Is process time-split? + integer :: nprg_active ! "Active" scheme: Number of prognostic variables contains generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D From 9465b6f1a63606cf3ae4c0d48feab0507f338be4 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 11 Jul 2023 14:48:26 -0600 Subject: [PATCH 024/122] Housekeeping --- physics/GFS_ccpp_scheme_sim_pre.F90 | 21 +++++++++++++-------- physics/ccpp_scheme_simulator.F90 | 22 +++++++++++++++++----- 2 files changed, 30 insertions(+), 13 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index a5f6f0cfa..61ab573a3 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -1,8 +1,12 @@ ! ######################################################################################## ! -! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. -! ) load: read and load data into type used by ccpp_scheme_simulator -! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! Description: Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! +! Contains: +! - load_ccpp_scheme_sim(): read and load data into type used by ccpp_scheme_simulator. +! called once during model initialization +! - GFS_ccpp_scheme_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_scheme_simulator. ! ! ######################################################################################## module GFS_ccpp_scheme_sim_pre @@ -102,8 +106,8 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process end subroutine GFS_ccpp_scheme_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & - iactive_T, iactive_u, iactive_v, iactive_q, errmsg, errflg) + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, & + iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs integer, intent (in) :: nlunit @@ -121,7 +125,8 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & logical :: exists, do_ccpp_scheme_sim integer :: nprc_sim - ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! For each process there is a corresponding namelist entry, which is constructed as + ! follows: ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} integer, dimension(3) :: & prc_LWRAD_cfg = (/0,0,0/), & @@ -133,8 +138,8 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & prc_cldMP_cfg = (/0,0,0/) ! Namelist - namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & - prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & prc_DCNV_cfg, prc_cldMP_cfg errmsg = '' diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index b825b8403..f3a6372ac 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -1,8 +1,20 @@ ! ######################################################################################## -! -! CCPP scheme to replace physics schemes with simulated data tendencies. ! -! Description: +! Description: This scheme simulates the evolution of the internal physics state +! represented by a CCPP Suite Definition File (SDF). +! +! To activate this scheme it must be a) embedded within the SDF and b) activated through +! the physics namelist. +! The derived-data type "base_physics_process" contains the metadata needed to reconstruct +! the temporal evolution of the state. An array of base_physics_process, physics_process, +! is populated by the host during initialization and passed to the physics. Additionally, +! this type holds any data, or type-bound procedures, required by the scheme simulator(s). +! +! For this initial demonstration we are using 2-dimensional (height, time) forcing data, +! which is on the same native vertical grid as the SCM. The dataset has a temporal +! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool +! International Cloud Experiment (TWPICE) case. This was to create a dataset with a +! (constant) diurnal cycle. ! ! ######################################################################################## module ccpp_scheme_simulator @@ -160,9 +172,9 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j endif else if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' time split scheme (active)' + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' process split scheme (active)' + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' endif write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active endif From c61a2a61e7493c4b3dccae26761bdbd4f1939c5b Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 13 Jul 2023 11:01:50 -0600 Subject: [PATCH 025/122] GNU bug found in SCM CI --- physics/GFS_ccpp_scheme_sim_pre.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index 61ab573a3..db80e0c84 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -159,9 +159,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, close (nlunit) ! Only proceed if scheme simulator requested. - if (prc_SWRAD_cfg(1) .or. prc_LWRAD_cfg(1) .or. prc_PBL_cfg(1) .or. & - prc_GWD_cfg(1) .or. prc_SCNV_cfg(1) .or. prc_DCNV_cfg(1) .or. & - prc_cldMP_cfg(1)) then + if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & + prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & + prc_cldMP_cfg(1) == 1 ) then else return endif From 8e5646e91dc31ac88baf4905eeb3056578b8aa9e Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 17 Jul 2023 18:08:45 -0600 Subject: [PATCH 026/122] Some cleanup. --- physics/GFS_ccpp_scheme_sim_pre.F90 | 14 +++++++++----- physics/GFS_ccpp_scheme_sim_pre.meta | 7 +++++++ 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index db80e0c84..47865353d 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -25,13 +25,15 @@ module GFS_ccpp_scheme_sim_pre !! \section arg_table_GFS_ccpp_scheme_sim_pre_run !! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html !! - subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, physics_process, & - iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, errmsg, errflg) + subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, dtp, & + index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & + index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & + index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & + errmsg, errflg) ! Inputs + logical, intent(in) :: do_ccpp_scheme_sim integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -54,6 +56,8 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process errmsg = '' errflg = 0 + if (.not. do_ccpp_scheme_sim) return + ! Get tendency for "active" process. ! ###################################################################################### diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index 682b4baf8..ca6d4f7cc 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -7,6 +7,13 @@ [ccpp-arg-table] name = GFS_ccpp_scheme_sim_pre_run type = scheme +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator From e3c00d35207299024be4b016a2db8c3ad40f3ea7 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 11:53:00 -0600 Subject: [PATCH 027/122] Renamed scheme simulator suite simulator --- ...sim_pre.F90 => GFS_ccpp_suite_sim_pre.F90} | 74 +++++++++---------- ...m_pre.meta => GFS_ccpp_suite_sim_pre.meta} | 40 +++++----- ...simulator.F90 => ccpp_suite_simulator.F90} | 28 +++---- ...mulator.meta => ccpp_suite_simulator.meta} | 56 +++++++------- ...or.F90 => module_ccpp_suite_simulator.F90} | 10 +-- ....meta => module_ccpp_suite_simulator.meta} | 4 +- 6 files changed, 106 insertions(+), 106 deletions(-) rename physics/{GFS_ccpp_scheme_sim_pre.F90 => GFS_ccpp_suite_sim_pre.F90} (86%) rename physics/{GFS_ccpp_scheme_sim_pre.meta => GFS_ccpp_suite_sim_pre.meta} (83%) rename physics/{ccpp_scheme_simulator.F90 => ccpp_suite_simulator.F90} (91%) rename physics/{ccpp_scheme_simulator.meta => ccpp_suite_simulator.meta} (76%) rename physics/{module_ccpp_scheme_simulator.F90 => module_ccpp_suite_simulator.F90} (98%) rename physics/{module_ccpp_scheme_simulator.meta => module_ccpp_suite_simulator.meta} (86%) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_suite_sim_pre.F90 similarity index 86% rename from physics/GFS_ccpp_scheme_sim_pre.F90 rename to physics/GFS_ccpp_suite_sim_pre.F90 index 47865353d..fbaf5a1d9 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_suite_sim_pre.F90 @@ -1,31 +1,31 @@ ! ######################################################################################## ! -! Description: Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. ! ! Contains: -! - load_ccpp_scheme_sim(): read and load data into type used by ccpp_scheme_simulator. +! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. ! called once during model initialization -! - GFS_ccpp_scheme_sim_pre_run(): prepare GFS diagnostic physics tendencies for -! ccpp_scheme_simulator. +! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_suite_simulator. ! ! ######################################################################################## -module GFS_ccpp_scheme_sim_pre +module GFS_ccpp_suite_sim_pre use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process + use module_ccpp_suite_simulator, only: base_physics_process use netcdf implicit none - public GFS_ccpp_scheme_sim_pre_run, load_ccpp_scheme_sim + public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim contains ! ###################################################################################### ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run + ! SUBROUTINE GFS_ccpp_suite_sim_pre_run ! ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_run -!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! \section arg_table_GFS_ccpp_suite_sim_pre_run +!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html !! - subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, dtp, & + subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & @@ -33,7 +33,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim + logical, intent(in) :: do_ccpp_suite_sim integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -56,7 +56,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return + if (.not. do_ccpp_suite_sim) return ! Get tendency for "active" process. @@ -64,7 +64,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional ! array, CCPP standard_name = cumulative_change_of_state_variables. ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics schemes. Not all schemes output physics tendencies... + ! the physics suites. Not all suites output physics tendencies... ! Rather these are intended for diagnostic puposes and are accumulated over some ! interval. ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option @@ -107,10 +107,10 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp endif - end subroutine GFS_ccpp_scheme_sim_pre_run + end subroutine GFS_ccpp_suite_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, & + subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs @@ -125,13 +125,13 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! Local variables integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data - character(len=256) :: scheme_sim_file - logical :: exists, do_ccpp_scheme_sim + character(len=256) :: suite_sim_file + logical :: exists, do_ccpp_suite_sim integer :: nprc_sim ! For each process there is a corresponding namelist entry, which is constructed as ! follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} integer, dimension(3) :: & prc_LWRAD_cfg = (/0,0,0/), & prc_SWRAD_cfg = (/0,0,0/), & @@ -142,7 +142,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, prc_cldMP_cfg = (/0,0,0/) ! Namelist - namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & prc_DCNV_cfg, prc_cldMP_cfg @@ -152,17 +152,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! Read in namelist inquire (file = trim (nml_file), exist = exists) if (.not. exists) then - errmsg = 'CCPP scheme simulator namelist file: '//trim(nml_file)//' does not exist.' + errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' errflg = 1 return else open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) endif rewind (nlunit) - read (nlunit, nml = ccpp_scheme_sim_nml, iostat=status) + read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) close (nlunit) - ! Only proceed if scheme simulator requested. + ! Only proceed if suite simulator requested. if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & prc_cldMP_cfg(1) == 1 ) then @@ -171,9 +171,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, endif ! Check that input data file exists. - inquire (file = trim (scheme_sim_file), exist = exists) + inquire (file = trim (suite_sim_file), exist = exists) if (.not. exists) then - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not exist' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' errflg = 1 return endif @@ -183,9 +183,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! ! Open file - status = nf90_open(trim(scheme_sim_file), NF90_NOWRITE, ncid) + status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) if (status /= nf90_noerr) then - errmsg = 'Error reading in CCPP scheme simulator file: '//trim(scheme_sim_file) + errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) errflg = 1 return endif @@ -195,7 +195,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) else - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [time] dimension' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' errflg = 1 return endif @@ -204,7 +204,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) else - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [lev] dimension' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' errflg = 1 return endif @@ -230,7 +230,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_file)//' does not contain times variable' + errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' errflg = 1 return endif @@ -403,7 +403,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) endif - ! Which process-scheme is "active"? Is process time-split? + ! Which process-suite is "active"? Is process time-split? if (.not. physics_process(iprc)%use_sim) then physics_process(1)%iactive_scheme = iprc physics_process(1)%active_name = physics_process(iprc)%name @@ -416,20 +416,20 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (physics_process(1)%iactive_scheme == 0) then errflg = 1 - errmsg = "ERROR: No active scheme set for CCPP scheme simulator" + errmsg = "ERROR: No active suite set for CCPP suite simulator" return endif print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" + print*, "--- Using CCPP suite simulator ---" print*, "-----------------------------------" do iprc = 1,nprc_sim if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," simulate_suite: ", trim(physics_process(iprc)%name) print*," order: ", physics_process(iprc)%order print*," time_split: ", physics_process(iprc)%time_split else - print*, " active_scheme: ", trim(physics_process(1)%active_name) + print*, " active_suite: ", trim(physics_process(1)%active_name) print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order print*, " time_split : ", physics_process(1)%active_tsp endif @@ -437,6 +437,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, print*, "-----------------------------------" print*, "-----------------------------------" - end subroutine load_ccpp_scheme_sim + end subroutine load_ccpp_suite_sim -end module GFS_ccpp_scheme_sim_pre +end module GFS_ccpp_suite_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_suite_sim_pre.meta similarity index 83% rename from physics/GFS_ccpp_scheme_sim_pre.meta rename to physics/GFS_ccpp_suite_sim_pre.meta index ca6d4f7cc..cc73813fa 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_suite_sim_pre.meta @@ -1,24 +1,24 @@ [ccpp-table-properties] - name = GFS_ccpp_scheme_sim_pre + name = GFS_ccpp_suite_sim_pre type = scheme - dependencies = machine.F,module_ccpp_scheme_simulator.F90 + dependencies = machine.F,module_ccpp_suite_simulator.F90 ######################################################################## [ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_run + name = GFS_ccpp_suite_sim_pre_run type = scheme -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator units = flag dimensions = () type = logical intent = in [physics_process] - standard_name = physics_process_type_for_CCPP_scheme_simulator - long_name = physics process type for CCPP scheme simulator + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator units = mixed - dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) type = base_physics_process intent = in [dtend] @@ -122,37 +122,37 @@ type = integer intent = in [active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator - long_name = tendencies for active physics process in ccpp scheme simulator + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) type = real kind = kind_phys intent = out [iactive_T] - standard_name = index_for_active_T_in_CCPP_scheme_simulator - long_name = index into active process tracer array for temperature in CCPP scheme simulator + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_u] - standard_name = index_for_active_u_in_CCPP_scheme_simulator - long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_v] - standard_name = index_for_active_v_in_CCPP_scheme_simulator - long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_q] - standard_name = index_for_active_q_in_CCPP_scheme_simulator - long_name = index into active process tracer array for moisture in CCPP scheme simulator + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator units = count dimensions = () type = integer diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_suite_simulator.F90 similarity index 91% rename from physics/ccpp_scheme_simulator.F90 rename to physics/ccpp_suite_simulator.F90 index f3a6372ac..c1592263d 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_suite_simulator.F90 @@ -1,14 +1,14 @@ ! ######################################################################################## ! -! Description: This scheme simulates the evolution of the internal physics state +! Description: This suite simulates the evolution of the internal physics state ! represented by a CCPP Suite Definition File (SDF). ! -! To activate this scheme it must be a) embedded within the SDF and b) activated through +! To activate this suite it must be a) embedded within the SDF and b) activated through ! the physics namelist. ! The derived-data type "base_physics_process" contains the metadata needed to reconstruct ! the temporal evolution of the state. An array of base_physics_process, physics_process, ! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the scheme simulator(s). +! this type holds any data, or type-bound procedures, required by the suite simulator(s). ! ! For this initial demonstration we are using 2-dimensional (height, time) forcing data, ! which is on the same native vertical grid as the SCM. The dataset has a temporal @@ -17,29 +17,29 @@ ! (constant) diurnal cycle. ! ! ######################################################################################## -module ccpp_scheme_simulator +module ccpp_suite_simulator use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none - public ccpp_scheme_simulator_run + public ccpp_suite_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simulator_run + ! SUBROUTINE ccpp_suite_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simulator_run -!! \htmlinclude ccpp_scheme_simulator_run.html +!! \section arg_table_ccpp_suite_simulator_run +!! \htmlinclude ccpp_suite_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & + subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& gv0, gq0, errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim + logical, intent(in) :: do_ccpp_suite_sim integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & iactive_v, iactive_q real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & @@ -60,7 +60,7 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return + if (.not. do_ccpp_suite_sim) return ! Current forecast time (Data-format specific) year = jdat(1) @@ -207,6 +207,6 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j in_post_active = .false. endif - end subroutine ccpp_scheme_simulator_run + end subroutine ccpp_suite_simulator_run -end module ccpp_scheme_simulator +end module ccpp_suite_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_suite_simulator.meta similarity index 76% rename from physics/ccpp_scheme_simulator.meta rename to physics/ccpp_suite_simulator.meta index c60cd9a38..f2737a263 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_suite_simulator.meta @@ -1,14 +1,14 @@ [ccpp-table-properties] - name = ccpp_scheme_simulator + name = ccpp_suite_simulator type = scheme - dependencies = machine.F,module_ccpp_scheme_simulator.F90 + dependencies = machine.F,module_ccpp_suite_simulator.F90 [ccpp-arg-table] - name = ccpp_scheme_simulator_run + name = ccpp_suite_simulator_run type = scheme -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator units = flag dimensions = () type = logical @@ -50,29 +50,29 @@ type = integer intent = in [proc_start] - standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator - long_name = index for first physics process in CCPP scheme simulator + standard_name = index_for_first_physics_process_in_CCPP_suite_simulator + long_name = index for first physics process in CCPP suite simulator units = count dimensions = () type = integer intent = inout [proc_end] - standard_name = index_for_last_physics_process_in_CCPP_scheme_simulator - long_name = index for last physics process in CCPP scheme simulator + standard_name = index_for_last_physics_process_in_CCPP_suite_simulator + long_name = index for last physics process in CCPP suite simulator units = count dimensions = () type = integer intent = inout [in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme - long_name = flag to indicate location in physics process loop before active scheme + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_suite + long_name = flag to indicate location in physics process loop before active suite units = flag dimensions = () type = logical intent = inout [in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme - long_name = flag to indicate location in physics process loop after active scheme + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_suite + long_name = flag to indicate location in physics process loop after active suite units = flag dimensions = () type = logical @@ -110,37 +110,37 @@ kind = kind_phys intent = in [active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator - long_name = tendencies for active physics process in ccpp scheme simulator + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) type = real kind = kind_phys intent = in [iactive_T] - standard_name = index_for_active_T_in_CCPP_scheme_simulator - long_name = index into active process tracer array for temperature in CCPP scheme simulator + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_u] - standard_name = index_for_active_u_in_CCPP_scheme_simulator - long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_v] - standard_name = index_for_active_v_in_CCPP_scheme_simulator - long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_q] - standard_name = index_for_active_q_in_CCPP_scheme_simulator - long_name = index into active process tracer array for moisture in CCPP scheme simulator + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator units = count dimensions = () type = integer @@ -178,10 +178,10 @@ kind = kind_phys intent = inout [physics_process] - standard_name = physics_process_type_for_CCPP_scheme_simulator - long_name = physics process type for CCPP scheme simulator + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator units = mixed - dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) type = base_physics_process intent = inout [errmsg] diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 similarity index 98% rename from physics/module_ccpp_scheme_simulator.F90 rename to physics/module_ccpp_suite_simulator.F90 index a122563d9..c759c583a 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_suite_simulator.F90 @@ -1,12 +1,12 @@ ! ######################################################################################## ! ! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp scheme simulator. +! by the ccpp suite simulator. ! ! ######################################################################################## -module module_ccpp_scheme_simulator -!> \section arg_table_module_ccpp_scheme_simulator Argument table -!! \htmlinclude module_ccpp_scheme_simulator.html +module module_ccpp_suite_simulator +!> \section arg_table_module_ccpp_suite_simulator Argument table +!! \htmlinclude module_ccpp_suite_simulator.html !! use machine, only : kind_phys implicit none @@ -307,4 +307,4 @@ subroutine sim_cldMP( year, month, day, hour, min, sec, process) endif end subroutine sim_cldMP -end module module_ccpp_scheme_simulator +end module module_ccpp_suite_simulator diff --git a/physics/module_ccpp_scheme_simulator.meta b/physics/module_ccpp_suite_simulator.meta similarity index 86% rename from physics/module_ccpp_scheme_simulator.meta rename to physics/module_ccpp_suite_simulator.meta index 8eefb228c..cd8e3db1b 100644 --- a/physics/module_ccpp_scheme_simulator.meta +++ b/physics/module_ccpp_suite_simulator.meta @@ -9,12 +9,12 @@ ######################################################################## [ccpp-table-properties] - name = module_ccpp_scheme_simulator + name = module_ccpp_suite_simulator type = module dependencies = machine.F [ccpp-arg-table] - name = module_ccpp_scheme_simulator + name = module_ccpp_suite_simulator type = module [base_physics_process] standard_name = base_physics_process From 2d6d44c8d56aa707d4e11901f1965df322c2322a Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 16:12:43 -0600 Subject: [PATCH 028/122] Omission from previous commit --- physics/ccpp_suite_simulator.meta | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/ccpp_suite_simulator.meta b/physics/ccpp_suite_simulator.meta index f2737a263..bfa664922 100644 --- a/physics/ccpp_suite_simulator.meta +++ b/physics/ccpp_suite_simulator.meta @@ -64,15 +64,15 @@ type = integer intent = inout [in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_suite - long_name = flag to indicate location in physics process loop before active suite + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme + long_name = flag to indicate location in physics process loop before active scheme units = flag dimensions = () type = logical intent = inout [in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_suite - long_name = flag to indicate location in physics process loop after active suite + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme + long_name = flag to indicate location in physics process loop after active scheme units = flag dimensions = () type = logical From 5ab1a5bb7385214ec8febaa0d2bef2f6a1377481 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 16:48:11 -0600 Subject: [PATCH 029/122] Add ability to use constant forcing data when one-dimensional data is provided. --- physics/module_ccpp_suite_simulator.F90 | 28 ++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/physics/module_ccpp_suite_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 index c759c583a..c4f9fc4e4 100644 --- a/physics/module_ccpp_suite_simulator.F90 +++ b/physics/module_ccpp_suite_simulator.F90 @@ -94,21 +94,39 @@ function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err character(len=*), intent(in) :: var_name integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: err_message - integer :: ti(1), tf(1) + integer :: ti(1), tf(1), ntime real(kind_phys) :: w1, w2 ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + ntime = size(this%tend2d%T(1,:)) + select case(var_name) case("T") - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + else + this%tend1d%T = this%tend2d%T(:,1) + endif case("u") - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + else + this%tend1d%u = this%tend2d%u(:,1) + endif case("v") - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + else + this%tend1d%v = this%tend2d%v(:,1) + endif case("q") - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + else + this%tend1d%q = this%tend2d%q(:,1) + endif end select end function linterp_1D From 9891fff7bd9eb8660a60ff203112298bf1349406 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 10:50:36 -0600 Subject: [PATCH 030/122] switch from in to inout for output variables --- physics/sfc_land.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index aec47ff77..d4e88c25a 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -112,7 +112,7 @@ subroutine sfc_land_run & & cmm_lnd, chh_lnd, zvfun_lnd ! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: & + real (kind=kind_phys), dimension(:), intent(inout) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & & runoff, drain, cmm, chh, zvfun ! From 70038f6f5f70572f09489732e3563f1d11066a1f Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 11:50:02 -0600 Subject: [PATCH 031/122] update meta file for sfc_land too --- physics/sfc_land.meta | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 979cca377..493d2a70b 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -153,7 +153,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [qsurf] standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land @@ -161,7 +161,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [evap] standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land @@ -169,7 +169,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [hflx] standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land @@ -177,7 +177,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [ep] standard_name = surface_upward_potential_latent_heat_flux_over_land long_name = surface upward potential latent heat flux over land @@ -185,7 +185,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp @@ -193,7 +193,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -201,7 +201,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [gflux] standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land @@ -209,7 +209,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [runoff] standard_name = surface_runoff_flux long_name = surface runoff flux @@ -217,7 +217,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [drain] standard_name = subsurface_runoff_flux long_name = subsurface runoff flux @@ -225,7 +225,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [cmm] standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land @@ -233,7 +233,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [chh] standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land @@ -241,7 +241,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [zvfun] standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction long_name = function of surface roughness length and green vegetation fraction @@ -249,7 +249,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6ec72e918d2f2d04f78a9afaf5b58968370a44a4 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 16:21:27 -0600 Subject: [PATCH 032/122] update sfc_land --- physics/sfc_land.F90 | 108 ++++++++++++++++++++++++++++++ physics/sfc_land.f | 154 ------------------------------------------- 2 files changed, 108 insertions(+), 154 deletions(-) create mode 100644 physics/sfc_land.F90 delete mode 100644 physics/sfc_land.f diff --git a/physics/sfc_land.F90 b/physics/sfc_land.F90 new file mode 100644 index 000000000..2b0696ed8 --- /dev/null +++ b/physics/sfc_land.F90 @@ -0,0 +1,108 @@ +!> \file sfc_land.F90 +!! This file contains the code for coupling to land component + +!> This module contains the CCPP-compliant GFS land post +!! interstitial codes, which returns updated surface +!! properties such as latent heat and sensible heat +!! provided by the component version of land model + +!> This module contains the CCPP-compliant GFS land scheme. + module sfc_land + + use machine, only : kind_phys + + contains + +!> \defgroup sfc_land for coupling to land +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_land_run Arguments +!! \htmlinclude sfc_land_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & + sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & + ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & + sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + gflux, runoff, drain, cmm, chh, zvfun, & + errmsg, errflg) + + implicit none + + ! Inputs + integer , intent(in) :: im + logical , intent(in) :: cpllnd + logical , intent(in) :: cpllnd2atm + logical , intent(in) :: flag_iter(:) + logical , intent(in) :: dry(:) + real(kind=kind_phys), intent(in) :: sncovr1_lnd(:) + real(kind=kind_phys), intent(in) :: qsurf_lnd(:) + real(kind=kind_phys), intent(in) :: evap_lnd(:) + real(kind=kind_phys), intent(in) :: hflx_lnd(:) + real(kind=kind_phys), intent(in) :: ep_lnd(:) + real(kind=kind_phys), intent(in) :: t2mmp_lnd(:) + real(kind=kind_phys), intent(in) :: q2mp_lnd(:) + real(kind=kind_phys), intent(in) :: gflux_lnd(:) + real(kind=kind_phys), intent(in) :: runoff_lnd(:) + real(kind=kind_phys), intent(in) :: drain_lnd(:) + real(kind=kind_phys), intent(in) :: cmm_lnd(:) + real(kind=kind_phys), intent(in) :: chh_lnd(:) + real(kind=kind_phys), intent(in) :: zvfun_lnd(:) + ! Inputs/Outputs + real(kind=kind_phys), intent(inout) :: sncovr1(:) + real(kind=kind_phys), intent(inout) :: qsurf(:) + real(kind=kind_phys), intent(inout) :: evap(:) + real(kind=kind_phys), intent(inout) :: hflx(:) + real(kind=kind_phys), intent(inout) :: ep(:) + real(kind=kind_phys), intent(inout) :: t2mmp(:) + real(kind=kind_phys), intent(inout) :: q2mp(:) + real(kind=kind_phys), intent(inout) :: gflux(:) + real(kind=kind_phys), intent(inout) :: runoff(:) + real(kind=kind_phys), intent(inout) :: drain(:) + real(kind=kind_phys), intent(inout) :: cmm(:) + real(kind=kind_phys), intent(inout) :: chh(:) + real(kind=kind_phys), intent(inout) :: zvfun(:) + ! Outputs + character(len=*) , intent(out) :: errmsg + integer , intent(out) :: errflg + + ! Locals + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check coupling from component land to atmosphere + if (.not. cpllnd2atm) return + + ! Fill variables + do i = 1, im + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) + enddo + + end subroutine sfc_land_run + +!> @} + end module sfc_land diff --git a/physics/sfc_land.f b/physics/sfc_land.f deleted file mode 100644 index d4e88c25a..000000000 --- a/physics/sfc_land.f +++ /dev/null @@ -1,154 +0,0 @@ -!> \file sfc_land.f -!! This file contains the code for coupling to land component - -!> This module contains the CCPP-compliant GFS land post -!! interstitial codes, which returns updated surface -!! properties such as latent heat and sensible heat -!! provided by the component version of land model - -!> This module contains the CCPP-compliant GFS land scheme. - module sfc_land - - contains - -!> \defgroup sfc_land for coupling to land -!! @{ -!! \section diagram Calling Hierarchy Diagram -!! \section intraphysics Intraphysics Communication -!! -!> \brief Brief description of the subroutine -!! -!! \section arg_table_sfc_land_run Arguments -!! \htmlinclude sfc_land_run.html -!! - -!! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ - -! -!----------------------------------- - subroutine sfc_land_run & -! --- inputs: - & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & - & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & - & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & -! --- outputs: - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, cmm, chh, zvfun, & - & errmsg, errflg - & ) - -! ===================================================================== ! -! description: ! -! Dec 2022 -- Ufuk Turuncoglu created for coupling to land ! -! ! -! usage: ! -! ! -! call sfc_land ! -! inputs: ! -! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! -! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! -! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! -! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! -! zvfun_lnd, ! -! outputs: ! -! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, cmm, chh, zvfun, ! -! errmsg, errflg) ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -! im - integer, horiz dimension -! cpllnd - logical, flag for land coupling -! cpllnd2atm - logical, flag for land coupling (lnd->atm) -! flag_iter - logical, flag for iteration -! dry - logical, eq T if a point with any land -! sncovr1_lnd - real , surface snow area fraction -! qsurf_lnd - real , specific humidity at sfc -! evap_lnd - real , evaporation from latent heat -! hflx_lnd - real , sensible heat -! ep_lnd - real , surface upward potential latent heat flux -! t2mmp_lnd - real , 2m temperature -! q2mp_lnd - real , 2m specific humidity -! gflux_lnd - real , soil heat flux over land -! runoff_lnd - real , surface runoff -! drain_lnd - real , subsurface runoff -! cmm_lnd - real , surface drag wind speed for momentum -! chh_lnd - real , surface drag mass flux for heat and moisture -! zvfun_lnd - real , function of surface roughness length and green vegetation fraction -! outputs: -! sncovr1 - real , snow cover over land -! qsurf - real , specific humidity at sfc -! evap - real , evaporation from latent heat -! hflx - real , sensible heat -! ep - real , potential evaporation -! t2mmp - real , temperature at 2m -! q2mp - real , specific humidity at 2m -! gflux - real , soil heat flux over land -! runoff - real , surface runoff -! drain - real , subsurface runoff -! cmm - real , surface drag wind speed for momentum -! chh - real , surface drag mass flux for heat and moisture -! zvfun - real , function of surface roughness length and green vegetation fraction -! ==================== end of description ===================== ! -! -! - use machine , only : kind_phys - implicit none - -! --- inputs: - integer, intent(in) :: im - logical, intent(in) :: cpllnd, cpllnd2atm - logical, dimension(:), intent(in) :: flag_iter - logical, dimension(:), intent(in) :: dry - - real (kind=kind_phys), dimension(:), intent(in) :: & - & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & - & cmm_lnd, chh_lnd, zvfun_lnd - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain, cmm, chh, zvfun -! - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals: - - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 -! - if (.not. cpllnd2atm) return -! - do i = 1, im - sncovr1(i) = sncovr1_lnd(i) - qsurf(i) = qsurf_lnd(i) - hflx(i) = hflx_lnd(i) - evap(i) = evap_lnd(i) - ep(i) = ep_lnd(i) - t2mmp(i) = t2mmp_lnd(i) - q2mp(i) = q2mp_lnd(i) - gflux(i) = gflux_lnd(i) - drain(i) = drain_lnd(i) - runoff(i) = runoff_lnd(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) - zvfun(i) = zvfun_lnd(i) - enddo - - return -!----------------------------------- - end subroutine sfc_land_run -!----------------------------------- - -!> @} - end module sfc_land From c31f9207d1d75f4a42e32404ba7ecad264f90404 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 1 Sep 2023 17:50:08 +0000 Subject: [PATCH 033/122] Reorganization --- .gitmodules | 2 +- physics/{ => CONV/CCC}/cu_c3_deep.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_driver_post.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver_post.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_driver_pre.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver_pre.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_sh.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv.meta | 2 +- .../{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.F90 | 0 .../{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.meta | 2 +- physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.meta | 2 +- physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_deep.F90 | 0 physics/{ => CONV/Grell_Freitas}/cu_gf_driver.F90 | 0 physics/{ => CONV/Grell_Freitas}/cu_gf_driver.meta | 2 +- .../{ => CONV/Grell_Freitas}/cu_gf_driver_post.F90 | 0 .../{ => CONV/Grell_Freitas}/cu_gf_driver_post.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.F90 | 0 .../{ => CONV/Grell_Freitas}/cu_gf_driver_pre.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_sh.F90 | 0 physics/{ => CONV/RAS}/rascnv.F90 | 0 physics/{ => CONV/RAS}/rascnv.meta | 2 +- physics/{ => CONV/SAMF}/samfaerosols.F | 0 physics/{ => CONV/SAMF}/samfdeepcnv.f | 0 physics/{ => CONV/SAMF}/samfdeepcnv.meta | 2 +- physics/{ => CONV/SAMF}/samfshalcnv.f | 0 physics/{ => CONV/SAMF}/samfshalcnv.meta | 2 +- physics/{ => CONV/SAS}/sascnvn.F | 0 physics/{ => CONV/SAS}/sascnvn.meta | 2 +- physics/{ => CONV/SAS}/shalcnv.F | 0 physics/{ => CONV/SAS}/shalcnv.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.meta | 2 +- physics/{ => CONV}/progsigma_calc.f90 | 0 physics/{ => GWD}/cires_orowam2017.f | 0 physics/{ => GWD}/cires_tauamf_data.F90 | 0 physics/{ => GWD}/cires_ugwp.F90 | 0 physics/{ => GWD}/cires_ugwp.meta | 2 +- physics/{ => GWD}/cires_ugwp_initialize.F90 | 0 physics/{ => GWD}/cires_ugwp_module.F90 | 0 physics/{ => GWD}/cires_ugwp_post.F90 | 0 physics/{ => GWD}/cires_ugwp_post.meta | 2 +- physics/{ => GWD}/cires_ugwp_triggers.F90 | 0 physics/{ => GWD}/cires_ugwpv1_initialize.F90 | 0 physics/{ => GWD}/cires_ugwpv1_module.F90 | 0 physics/{ => GWD}/cires_ugwpv1_oro.F90 | 0 physics/{ => GWD}/cires_ugwpv1_solv2.F90 | 0 physics/{ => GWD}/cires_ugwpv1_sporo.F90 | 0 physics/{ => GWD}/cires_ugwpv1_triggers.F90 | 0 physics/{ => GWD}/drag_suite.F90 | 0 physics/{ => GWD}/drag_suite.meta | 2 +- physics/{ => GWD}/gwdc.f | 0 physics/{ => GWD}/gwdc.meta | 2 +- physics/{ => GWD}/gwdc_post.f | 0 physics/{ => GWD}/gwdc_post.meta | 2 +- physics/{ => GWD}/gwdc_pre.f | 0 physics/{ => GWD}/gwdc_pre.meta | 2 +- physics/{ => GWD}/gwdps.f | 0 physics/{ => GWD}/gwdps.meta | 2 +- physics/{ => GWD}/rayleigh_damp.f | 0 physics/{ => GWD}/rayleigh_damp.meta | 2 +- physics/{ => GWD}/ugwp_driver_v0.F | 0 physics/{ => GWD}/ugwpv1_gsldrag.F90 | 0 physics/{ => GWD}/ugwpv1_gsldrag.meta | 2 +- physics/{ => GWD}/ugwpv1_gsldrag_post.F90 | 0 physics/{ => GWD}/ugwpv1_gsldrag_post.meta | 2 +- physics/{ => GWD}/unified_ugwp.F90 | 0 physics/{ => GWD}/unified_ugwp.meta | 8 ++++---- physics/{ => GWD}/unified_ugwp_post.F90 | 0 physics/{ => GWD}/unified_ugwp_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_DCNV_generic_post.F90 | 0 .../GFS}/GFS_DCNV_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_DCNV_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_DCNV_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_GWD_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_GWD_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_GWD_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_GWD_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_MP_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_MP_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_MP_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_MP_generic_pre.meta | 2 +- .../GFS}/GFS_PBL_generic_common.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_PBL_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_SCNV_generic_post.F90 | 0 .../GFS}/GFS_SCNV_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_SCNV_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_SCNV_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_cloud_diagnostics.F90 | 0 .../GFS}/GFS_cloud_diagnostics.meta | 3 ++- physics/{ => Interstitials/GFS}/GFS_debug.F90 | 0 physics/{ => Interstitials/GFS}/GFS_debug.meta | 2 +- .../GFS}/GFS_phys_time_vary.fv3.F90 | 0 .../GFS}/GFS_phys_time_vary.fv3.meta | 11 +++++++++-- .../GFS}/GFS_phys_time_vary.scm.F90 | 0 .../GFS}/GFS_phys_time_vary.scm.meta | 11 +++++++++-- .../{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.F90 | 0 .../GFS}/GFS_rad_time_vary.fv3.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_rad_time_vary.scm.F90 | 0 .../GFS}/GFS_rad_time_vary.scm.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_radiation_surface.F90 | 0 .../GFS}/GFS_radiation_surface.meta | 5 ++++- physics/{ => Interstitials/GFS}/GFS_rrtmg_post.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_post.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.meta | 10 +++++++--- physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.meta | 8 ++++++-- .../{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.F90 | 0 .../{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.meta | 5 ++++- .../GFS}/GFS_rrtmgp_cloud_overlap.F90 | 0 .../GFS}/GFS_rrtmgp_cloud_overlap.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.F90 | 1 - physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.meta | 5 +++-- physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.meta | 6 ++++-- physics/{ => Interstitials/GFS}/GFS_stochastics.F90 | 0 physics/{ => Interstitials/GFS}/GFS_stochastics.meta | 2 +- .../GFS}/GFS_suite_interstitial_1.F90 | 0 .../GFS}/GFS_suite_interstitial_1.meta | 2 +- .../GFS}/GFS_suite_interstitial_2.F90 | 0 .../GFS}/GFS_suite_interstitial_2.meta | 2 +- .../GFS}/GFS_suite_interstitial_3.F90 | 0 .../GFS}/GFS_suite_interstitial_3.meta | 2 +- .../GFS}/GFS_suite_interstitial_4.F90 | 0 .../GFS}/GFS_suite_interstitial_4.meta | 4 +++- .../GFS}/GFS_suite_interstitial_5.F90 | 0 .../GFS}/GFS_suite_interstitial_5.meta | 2 +- .../GFS}/GFS_suite_interstitial_phys_reset.F90 | 0 .../GFS}/GFS_suite_interstitial_phys_reset.meta | 2 +- .../GFS}/GFS_suite_interstitial_rad_reset.F90 | 0 .../GFS}/GFS_suite_interstitial_rad_reset.meta | 2 +- .../GFS}/GFS_suite_stateout_reset.F90 | 0 .../GFS}/GFS_suite_stateout_reset.meta | 2 +- .../GFS}/GFS_suite_stateout_update.F90 | 0 .../GFS}/GFS_suite_stateout_update.meta | 2 +- .../GFS}/GFS_surface_composites_inter.F90 | 0 .../GFS}/GFS_surface_composites_inter.meta | 2 +- .../GFS}/GFS_surface_composites_post.F90 | 0 .../GFS}/GFS_surface_composites_post.meta | 3 ++- .../GFS}/GFS_surface_composites_pre.F90 | 0 .../GFS}/GFS_surface_composites_pre.meta | 2 +- .../GFS}/GFS_surface_generic_post.F90 | 0 .../GFS}/GFS_surface_generic_post.meta | 2 +- .../GFS}/GFS_surface_generic_pre.F90 | 0 .../GFS}/GFS_surface_generic_pre.meta | 3 ++- .../GFS}/GFS_surface_loop_control_part1.F90 | 0 .../GFS}/GFS_surface_loop_control_part1.meta | 2 +- .../GFS}/GFS_surface_loop_control_part2.F90 | 0 .../GFS}/GFS_surface_loop_control_part2.meta | 2 +- .../{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.F90 | 0 .../GFS}/GFS_time_vary_pre.fv3.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_time_vary_pre.scm.F90 | 0 .../GFS}/GFS_time_vary_pre.scm.meta | 3 ++- physics/{ => Interstitials/GFS}/aerinterp.F90 | 0 physics/{ => Interstitials/GFS}/cnvc90.f | 0 physics/{ => Interstitials/GFS}/cnvc90.meta | 2 +- physics/{ => Interstitials/GFS}/dcyc2t3.f | 0 physics/{ => Interstitials/GFS}/dcyc2t3.meta | 2 +- physics/{ => Interstitials/GFS}/gcycle.F90 | 0 physics/{ => Interstitials/GFS}/iccn_def.F | 0 physics/{ => Interstitials/GFS}/iccninterp.F90 | 0 .../GFS}/maximum_hourly_diagnostics.F90 | 0 .../GFS}/maximum_hourly_diagnostics.meta | 2 +- physics/{ => Interstitials/GFS}/phys_tend.F90 | 0 physics/{ => Interstitials/GFS}/phys_tend.meta | 2 +- physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.F90 | 0 .../{ => Interstitials/GFS}/scm_sfc_flux_spec.meta | 2 +- physics/{ => Interstitials/GFS}/sfcsub.F | 0 physics/{ => Interstitials/GFS}/sgscloud_radpost.F90 | 0 physics/{ => Interstitials/GFS}/sgscloud_radpost.meta | 2 +- physics/{ => Interstitials/GFS}/sgscloud_radpre.F90 | 0 physics/{ => Interstitials/GFS}/sgscloud_radpre.meta | 5 ++++- physics/{ => Land/CLM_lake}/clm_lake.f90 | 0 physics/{ => Land/CLM_lake}/clm_lake.meta | 2 +- physics/{ => Land/Flake}/flake.F90 | 0 physics/{ => Land/Flake}/flake_driver.F90 | 0 physics/{ => Land/Flake}/flake_driver.meta | 2 +- physics/{ => Land/Noah}/lsm_noah.f | 0 physics/{ => Land/Noah}/lsm_noah.meta | 3 ++- physics/{ => Land/Noah}/sflx.f | 0 physics/{ => Land/Noah}/surface_perturbation.F90 | 0 .../{ => Land/Noahmp}/module_sf_noahmp_glacier.F90 | 0 physics/{ => Land/Noahmp}/module_sf_noahmplsm.F90 | 0 physics/{ => Land/Noahmp}/noahmp_tables.f90 | 0 physics/{ => Land/Noahmp}/noahmpdrv.F90 | 0 physics/{ => Land/Noahmp}/noahmpdrv.meta | 2 +- physics/{ => Land/Noahmp}/noahmptable.tbl | 0 physics/{ => Land/RUC}/lsm_ruc.F90 | 0 physics/{ => Land/RUC}/lsm_ruc.meta | 2 +- physics/{ => Land/RUC}/module_sf_ruclsm.F90 | 0 physics/{ => Land/RUC}/module_soil_pre.F90 | 0 physics/{ => Land/RUC}/namelist_soilveg_ruc.F90 | 0 physics/{ => Land/RUC}/set_soilveg_ruc.F90 | 0 physics/{ => Land}/namelist_soilveg.f | 0 physics/{ => Land}/set_soilveg.f | 0 .../{ => MP/Ferrier_Aligo}/module_MP_FER_HIRES.F90 | 0 physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.F90 | 0 physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.meta | 2 +- physics/{ => MP/GFDL}/GFDL_parse_tracers.F90 | 0 physics/{ => MP/GFDL}/fv_sat_adj.F90 | 0 physics/{ => MP/GFDL}/fv_sat_adj.meta | 2 +- physics/{ => MP/GFDL}/gfdl_cloud_microphys.F90 | 0 physics/{ => MP/GFDL}/gfdl_cloud_microphys.meta | 2 +- physics/{ => MP/GFDL}/gfdl_sfc_layer.F90 | 0 physics/{ => MP/GFDL}/gfdl_sfc_layer.meta | 2 +- physics/{ => MP/GFDL}/module_gfdl_cloud_microphys.F90 | 0 physics/{ => MP/GFDL}/module_sf_exchcoef.f90 | 0 physics/{ => MP/GFDL}/multi_gases.F90 | 0 physics/{ => MP/Morrison_Gettelman}/aer_cloud.F | 0 physics/{ => MP/Morrison_Gettelman}/aerclm_def.F | 0 physics/{ => MP/Morrison_Gettelman}/cldmacro.F | 0 physics/{ => MP/Morrison_Gettelman}/cldwat2m_micro.F | 0 physics/{ => MP/Morrison_Gettelman}/m_micro.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/m_micro_post.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro_post.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/m_micro_pre.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro_pre.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/micro_mg2_0.F90 | 0 physics/{ => MP/Morrison_Gettelman}/micro_mg3_0.F90 | 0 .../{ => MP/Morrison_Gettelman}/micro_mg_utils.F90 | 0 physics/{ => MP/Morrison_Gettelman}/wv_saturation.F | 0 physics/{ => MP/NSSL}/module_mp_nssl_2mom.F90 | 0 physics/{ => MP/NSSL}/mp_nssl.F90 | 0 physics/{ => MP/NSSL}/mp_nssl.meta | 2 +- physics/{ => MP/Thompson}/module_mp_radar.F90 | 0 physics/{ => MP/Thompson}/module_mp_thompson.F90 | 0 .../module_mp_thompson_make_number_concentrations.F90 | 0 physics/{ => MP/Thompson}/mp_thompson.F90 | 0 physics/{ => MP/Thompson}/mp_thompson.meta | 2 +- physics/{ => MP/Thompson}/mp_thompson_post.F90 | 0 physics/{ => MP/Thompson}/mp_thompson_post.meta | 2 +- physics/{ => MP/Thompson}/mp_thompson_pre.F90 | 0 physics/{ => MP/Thompson}/mp_thompson_pre.meta | 2 +- physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.f | 0 physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.meta | 2 +- physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.f | 0 physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.meta | 2 +- physics/{ => MP}/calpreciptype.f90 | 0 physics/{ => NOTUSED}/gfs_phy_tracer_config.F | 0 physics/{ => NOTUSED}/gocart_tracer_config_stub.f | 0 physics/{ => NOTUSED}/rrtmg_lw_pre.F90 | 0 physics/{ => NOTUSED}/rrtmg_lw_pre.meta | 0 physics/{ => PBL/HEDMF}/hedmf.f | 0 physics/{ => PBL/HEDMF}/hedmf.meta | 2 +- physics/{ => PBL/MYJ}/module_BL_MYJPBL.F90 | 0 physics/{ => PBL/MYJ}/myjpbl_wrapper.F90 | 0 physics/{ => PBL/MYJ}/myjpbl_wrapper.meta | 2 +- physics/{ => PBL/MYNN_EDMF}/bl_mynn_common.f90 | 0 physics/{ => PBL/MYNN_EDMF}/module_bl_mynn.F90 | 0 physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.F90 | 0 physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.meta | 2 +- physics/{ => PBL/SATMEDMF}/mfscu.f | 0 physics/{ => PBL/SATMEDMF}/mfscuq.f | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdif.F | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdif.meta | 2 +- physics/{ => PBL/SATMEDMF}/satmedmfvdifq.F | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdifq.meta | 2 +- physics/{ => PBL/SHOC}/moninshoc.f | 0 physics/{ => PBL/SHOC}/moninshoc.meta | 2 +- physics/{ => PBL/SHOC}/shoc.F90 | 0 physics/{ => PBL/SHOC}/shoc.meta | 2 +- physics/{ => PBL/YSU}/ysuvdif.F90 | 0 physics/{ => PBL/YSU}/ysuvdif.meta | 2 +- physics/{ => PBL}/mfpbl.f | 0 physics/{ => PBL}/mfpblt.f | 0 physics/{ => PBL}/mfpbltq.f | 0 physics/{ => PBL/saYSU}/shinhongvdif.F90 | 0 physics/{ => PBL/saYSU}/shinhongvdif.meta | 2 +- physics/{ => PBL}/tridi.f | 0 physics/{ => Radiation/RRTMG}/iounitdef.f | 0 physics/{ => Radiation/RRTMG}/module_bfmicrophysics.f | 0 physics/{ => Radiation/RRTMG}/rad_sw_pre.F90 | 0 physics/{ => Radiation/RRTMG}/rad_sw_pre.meta | 2 +- physics/{ => Radiation/RRTMG}/radcons.f90 | 0 physics/{ => Radiation/RRTMG}/radlw_datatb.f | 0 physics/{ => Radiation/RRTMG}/radlw_main.F90 | 0 physics/{ => Radiation/RRTMG}/radlw_main.meta | 2 +- physics/{ => Radiation/RRTMG}/radlw_param.f | 0 physics/{ => Radiation/RRTMG}/radlw_param.meta | 0 physics/{ => Radiation/RRTMG}/radsw_datatb.f | 0 physics/{ => Radiation/RRTMG}/radsw_main.F90 | 0 physics/{ => Radiation/RRTMG}/radsw_main.meta | 2 +- physics/{ => Radiation/RRTMG}/radsw_param.f | 0 physics/{ => Radiation/RRTMG}/radsw_param.meta | 0 .../{ => Radiation/RRTMG}/rrtmg_lw_cloud_optics.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_lw_post.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_lw_post.meta | 2 +- .../{ => Radiation/RRTMG}/rrtmg_sw_cloud_optics.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_sw_post.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_sw_post.meta | 2 +- .../{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.meta | 2 +- .../{ => Radiation/RRTMGP}/rrtmgp_lw_cloud_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_lw_gas_optics.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.meta | 7 ++++--- physics/{ => Radiation/RRTMGP}/rrtmgp_sampling.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_sw_cloud_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_sw_gas_optics.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.meta | 7 ++++--- physics/{ => Radiation}/mersenne_twister.f | 0 physics/{ => Radiation}/radiation_aerosols.f | 0 physics/{ => Radiation}/radiation_astronomy.f | 0 physics/{ => Radiation}/radiation_cloud_overlap.F90 | 0 physics/{ => Radiation}/radiation_clouds.f | 0 physics/{ => Radiation}/radiation_gases.f | 0 physics/{ => Radiation}/radiation_surface.f | 0 physics/{ => Radiation}/radiation_tools.F90 | 0 physics/{ => SFC_Layer/GFS_sfc}/date_def.f | 0 physics/{ => SFC_Layer/GFS_sfc}/module_nst_model.f90 | 0 .../{ => SFC_Layer/GFS_sfc}/module_nst_parameters.f90 | 0 .../{ => SFC_Layer/GFS_sfc}/module_nst_water_prop.f90 | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.F90 | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.F | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.meta | 3 ++- physics/{ => SFC_Layer/MYJ}/module_SF_JSFC.F90 | 0 physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.F90 | 0 physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.meta | 2 +- physics/{ => SFC_Layer/MYNN}/module_sf_mynn.F90 | 0 physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.F90 | 0 physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.meta | 2 +- physics/{ => h2o_photo}/h2o_def.f | 0 physics/{ => h2o_photo}/h2o_def.meta | 2 +- physics/{ => h2o_photo}/h2ointerp.f90 | 0 physics/{ => h2o_photo}/h2ophys.f | 0 physics/{ => h2o_photo}/h2ophys.meta | 2 +- physics/{ => hooks}/machine.F | 0 physics/{ => hooks}/machine.meta | 0 physics/{ => hooks}/physcons.F90 | 0 physics/{ => o3_photo}/ozinterp.f90 | 0 physics/{ => o3_photo}/ozne_def.f | 0 physics/{ => o3_photo}/ozne_def.meta | 2 +- physics/{ => o3_photo}/ozphys.f | 0 physics/{ => o3_photo}/ozphys.meta | 2 +- physics/{ => o3_photo}/ozphys_2015.f | 0 physics/{ => o3_photo}/ozphys_2015.meta | 2 +- physics/rte-rrtmgp | 1 - physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.meta | 2 +- physics/{ => tools}/funcphys.f90 | 0 physics/{ => tools}/get_phi_fv3.F90 | 0 physics/{ => tools}/get_phi_fv3.meta | 2 +- physics/{ => tools}/get_prs_fv3.F90 | 0 physics/{ => tools}/get_prs_fv3.meta | 2 +- 376 files changed, 208 insertions(+), 153 deletions(-) rename physics/{ => CONV/CCC}/cu_c3_deep.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver.meta (99%) rename physics/{ => CONV/CCC}/cu_c3_driver_post.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver_post.meta (98%) rename physics/{ => CONV/CCC}/cu_c3_driver_pre.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver_pre.meta (98%) rename physics/{ => CONV/CCC}/cu_c3_sh.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv.meta (99%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.meta (99%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.meta (97%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.meta (99%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_deep.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver.meta (99%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_post.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_post.meta (98%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.meta (98%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_sh.F90 (100%) rename physics/{ => CONV/RAS}/rascnv.F90 (100%) rename physics/{ => CONV/RAS}/rascnv.meta (99%) rename physics/{ => CONV/SAMF}/samfaerosols.F (100%) rename physics/{ => CONV/SAMF}/samfdeepcnv.f (100%) rename physics/{ => CONV/SAMF}/samfdeepcnv.meta (99%) rename physics/{ => CONV/SAMF}/samfshalcnv.f (100%) rename physics/{ => CONV/SAMF}/samfshalcnv.meta (99%) rename physics/{ => CONV/SAS}/sascnvn.F (100%) rename physics/{ => CONV/SAS}/sascnvn.meta (99%) rename physics/{ => CONV/SAS}/shalcnv.F (100%) rename physics/{ => CONV/SAS}/shalcnv.meta (99%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke.meta (99%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.meta (97%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.meta (98%) rename physics/{ => CONV}/progsigma_calc.f90 (100%) rename physics/{ => GWD}/cires_orowam2017.f (100%) rename physics/{ => GWD}/cires_tauamf_data.F90 (100%) rename physics/{ => GWD}/cires_ugwp.F90 (100%) rename physics/{ => GWD}/cires_ugwp.meta (99%) rename physics/{ => GWD}/cires_ugwp_initialize.F90 (100%) rename physics/{ => GWD}/cires_ugwp_module.F90 (100%) rename physics/{ => GWD}/cires_ugwp_post.F90 (100%) rename physics/{ => GWD}/cires_ugwp_post.meta (99%) rename physics/{ => GWD}/cires_ugwp_triggers.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_initialize.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_module.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_oro.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_solv2.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_sporo.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_triggers.F90 (100%) rename physics/{ => GWD}/drag_suite.F90 (100%) rename physics/{ => GWD}/drag_suite.meta (99%) rename physics/{ => GWD}/gwdc.f (100%) rename physics/{ => GWD}/gwdc.meta (99%) rename physics/{ => GWD}/gwdc_post.f (100%) rename physics/{ => GWD}/gwdc_post.meta (99%) rename physics/{ => GWD}/gwdc_pre.f (100%) rename physics/{ => GWD}/gwdc_pre.meta (99%) rename physics/{ => GWD}/gwdps.f (100%) rename physics/{ => GWD}/gwdps.meta (99%) rename physics/{ => GWD}/rayleigh_damp.f (100%) rename physics/{ => GWD}/rayleigh_damp.meta (99%) rename physics/{ => GWD}/ugwp_driver_v0.F (100%) rename physics/{ => GWD}/ugwpv1_gsldrag.F90 (100%) rename physics/{ => GWD}/ugwpv1_gsldrag.meta (99%) rename physics/{ => GWD}/ugwpv1_gsldrag_post.F90 (100%) rename physics/{ => GWD}/ugwpv1_gsldrag_post.meta (99%) rename physics/{ => GWD}/unified_ugwp.F90 (100%) rename physics/{ => GWD}/unified_ugwp.meta (99%) rename physics/{ => GWD}/unified_ugwp_post.F90 (100%) rename physics/{ => GWD}/unified_ugwp_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_common.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_cloud_diagnostics.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_cloud_diagnostics.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_debug.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_debug.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.scm.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.scm.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_radiation_surface.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_radiation_surface.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_post.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_overlap.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_overlap.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.F90 (99%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_stochastics.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_stochastics.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_1.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_1.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_2.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_2.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_3.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_4.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_4.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_5.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_5.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_phys_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_phys_reset.meta (96%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_rad_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_rad_reset.meta (96%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_reset.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_update.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_update.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_inter.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_inter.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part1.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part1.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part2.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part2.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.scm.meta (98%) rename physics/{ => Interstitials/GFS}/aerinterp.F90 (100%) rename physics/{ => Interstitials/GFS}/cnvc90.f (100%) rename physics/{ => Interstitials/GFS}/cnvc90.meta (98%) rename physics/{ => Interstitials/GFS}/dcyc2t3.f (100%) rename physics/{ => Interstitials/GFS}/dcyc2t3.meta (99%) rename physics/{ => Interstitials/GFS}/gcycle.F90 (100%) rename physics/{ => Interstitials/GFS}/iccn_def.F (100%) rename physics/{ => Interstitials/GFS}/iccninterp.F90 (100%) rename physics/{ => Interstitials/GFS}/maximum_hourly_diagnostics.F90 (100%) rename physics/{ => Interstitials/GFS}/maximum_hourly_diagnostics.meta (99%) rename physics/{ => Interstitials/GFS}/phys_tend.F90 (100%) rename physics/{ => Interstitials/GFS}/phys_tend.meta (98%) rename physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.F90 (100%) rename physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.meta (99%) rename physics/{ => Interstitials/GFS}/sfcsub.F (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpost.F90 (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpost.meta (98%) rename physics/{ => Interstitials/GFS}/sgscloud_radpre.F90 (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpre.meta (98%) rename physics/{ => Land/CLM_lake}/clm_lake.f90 (100%) rename physics/{ => Land/CLM_lake}/clm_lake.meta (99%) rename physics/{ => Land/Flake}/flake.F90 (100%) rename physics/{ => Land/Flake}/flake_driver.F90 (100%) rename physics/{ => Land/Flake}/flake_driver.meta (99%) rename physics/{ => Land/Noah}/lsm_noah.f (100%) rename physics/{ => Land/Noah}/lsm_noah.meta (99%) rename physics/{ => Land/Noah}/sflx.f (100%) rename physics/{ => Land/Noah}/surface_perturbation.F90 (100%) rename physics/{ => Land/Noahmp}/module_sf_noahmp_glacier.F90 (100%) rename physics/{ => Land/Noahmp}/module_sf_noahmplsm.F90 (100%) rename physics/{ => Land/Noahmp}/noahmp_tables.f90 (100%) rename physics/{ => Land/Noahmp}/noahmpdrv.F90 (100%) rename physics/{ => Land/Noahmp}/noahmpdrv.meta (99%) rename physics/{ => Land/Noahmp}/noahmptable.tbl (100%) rename physics/{ => Land/RUC}/lsm_ruc.F90 (100%) rename physics/{ => Land/RUC}/lsm_ruc.meta (99%) rename physics/{ => Land/RUC}/module_sf_ruclsm.F90 (100%) rename physics/{ => Land/RUC}/module_soil_pre.F90 (100%) rename physics/{ => Land/RUC}/namelist_soilveg_ruc.F90 (100%) rename physics/{ => Land/RUC}/set_soilveg_ruc.F90 (100%) rename physics/{ => Land}/namelist_soilveg.f (100%) rename physics/{ => Land}/set_soilveg.f (100%) rename physics/{ => MP/Ferrier_Aligo}/module_MP_FER_HIRES.F90 (100%) rename physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.F90 (100%) rename physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.meta (99%) rename physics/{ => MP/GFDL}/GFDL_parse_tracers.F90 (100%) rename physics/{ => MP/GFDL}/fv_sat_adj.F90 (100%) rename physics/{ => MP/GFDL}/fv_sat_adj.meta (99%) rename physics/{ => MP/GFDL}/gfdl_cloud_microphys.F90 (100%) rename physics/{ => MP/GFDL}/gfdl_cloud_microphys.meta (99%) rename physics/{ => MP/GFDL}/gfdl_sfc_layer.F90 (100%) rename physics/{ => MP/GFDL}/gfdl_sfc_layer.meta (99%) rename physics/{ => MP/GFDL}/module_gfdl_cloud_microphys.F90 (100%) rename physics/{ => MP/GFDL}/module_sf_exchcoef.f90 (100%) rename physics/{ => MP/GFDL}/multi_gases.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/aer_cloud.F (100%) rename physics/{ => MP/Morrison_Gettelman}/aerclm_def.F (100%) rename physics/{ => MP/Morrison_Gettelman}/cldmacro.F (100%) rename physics/{ => MP/Morrison_Gettelman}/cldwat2m_micro.F (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_post.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_post.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_pre.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_pre.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg2_0.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg3_0.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg_utils.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/wv_saturation.F (100%) rename physics/{ => MP/NSSL}/module_mp_nssl_2mom.F90 (100%) rename physics/{ => MP/NSSL}/mp_nssl.F90 (100%) rename physics/{ => MP/NSSL}/mp_nssl.meta (99%) rename physics/{ => MP/Thompson}/module_mp_radar.F90 (100%) rename physics/{ => MP/Thompson}/module_mp_thompson.F90 (100%) rename physics/{ => MP/Thompson}/module_mp_thompson_make_number_concentrations.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson.meta (99%) rename physics/{ => MP/Thompson}/mp_thompson_post.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson_post.meta (98%) rename physics/{ => MP/Thompson}/mp_thompson_pre.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson_pre.meta (97%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.f (100%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.meta (98%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.f (100%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.meta (98%) rename physics/{ => MP}/calpreciptype.f90 (100%) rename physics/{ => NOTUSED}/gfs_phy_tracer_config.F (100%) rename physics/{ => NOTUSED}/gocart_tracer_config_stub.f (100%) rename physics/{ => NOTUSED}/rrtmg_lw_pre.F90 (100%) rename physics/{ => NOTUSED}/rrtmg_lw_pre.meta (100%) rename physics/{ => PBL/HEDMF}/hedmf.f (100%) rename physics/{ => PBL/HEDMF}/hedmf.meta (99%) rename physics/{ => PBL/MYJ}/module_BL_MYJPBL.F90 (100%) rename physics/{ => PBL/MYJ}/myjpbl_wrapper.F90 (100%) rename physics/{ => PBL/MYJ}/myjpbl_wrapper.meta (99%) rename physics/{ => PBL/MYNN_EDMF}/bl_mynn_common.f90 (100%) rename physics/{ => PBL/MYNN_EDMF}/module_bl_mynn.F90 (100%) rename physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.F90 (100%) rename physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.meta (99%) rename physics/{ => PBL/SATMEDMF}/mfscu.f (100%) rename physics/{ => PBL/SATMEDMF}/mfscuq.f (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdif.F (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdif.meta (99%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdifq.F (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdifq.meta (99%) rename physics/{ => PBL/SHOC}/moninshoc.f (100%) rename physics/{ => PBL/SHOC}/moninshoc.meta (99%) rename physics/{ => PBL/SHOC}/shoc.F90 (100%) rename physics/{ => PBL/SHOC}/shoc.meta (99%) rename physics/{ => PBL/YSU}/ysuvdif.F90 (100%) rename physics/{ => PBL/YSU}/ysuvdif.meta (99%) rename physics/{ => PBL}/mfpbl.f (100%) rename physics/{ => PBL}/mfpblt.f (100%) rename physics/{ => PBL}/mfpbltq.f (100%) rename physics/{ => PBL/saYSU}/shinhongvdif.F90 (100%) rename physics/{ => PBL/saYSU}/shinhongvdif.meta (99%) rename physics/{ => PBL}/tridi.f (100%) rename physics/{ => Radiation/RRTMG}/iounitdef.f (100%) rename physics/{ => Radiation/RRTMG}/module_bfmicrophysics.f (100%) rename physics/{ => Radiation/RRTMG}/rad_sw_pre.F90 (100%) rename physics/{ => Radiation/RRTMG}/rad_sw_pre.meta (96%) rename physics/{ => Radiation/RRTMG}/radcons.f90 (100%) rename physics/{ => Radiation/RRTMG}/radlw_datatb.f (100%) rename physics/{ => Radiation/RRTMG}/radlw_main.F90 (100%) rename physics/{ => Radiation/RRTMG}/radlw_main.meta (99%) rename physics/{ => Radiation/RRTMG}/radlw_param.f (100%) rename physics/{ => Radiation/RRTMG}/radlw_param.meta (100%) rename physics/{ => Radiation/RRTMG}/radsw_datatb.f (100%) rename physics/{ => Radiation/RRTMG}/radsw_main.F90 (100%) rename physics/{ => Radiation/RRTMG}/radsw_main.meta (99%) rename physics/{ => Radiation/RRTMG}/radsw_param.f (100%) rename physics/{ => Radiation/RRTMG}/radsw_param.meta (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_post.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_post.meta (99%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_post.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_post.meta (99%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.meta (98%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_gas_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.meta (98%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sampling.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_gas_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.meta (98%) rename physics/{ => Radiation}/mersenne_twister.f (100%) rename physics/{ => Radiation}/radiation_aerosols.f (100%) rename physics/{ => Radiation}/radiation_astronomy.f (100%) rename physics/{ => Radiation}/radiation_cloud_overlap.F90 (100%) rename physics/{ => Radiation}/radiation_clouds.f (100%) rename physics/{ => Radiation}/radiation_gases.f (100%) rename physics/{ => Radiation}/radiation_surface.f (100%) rename physics/{ => Radiation}/radiation_tools.F90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/date_def.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_model.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_parameters.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_water_prop.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.F90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.meta (98%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.meta (98%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.meta (97%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.F (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.meta (99%) rename physics/{ => SFC_Layer/MYJ}/module_SF_JSFC.F90 (100%) rename physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.F90 (100%) rename physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.meta (99%) rename physics/{ => SFC_Layer/MYNN}/module_sf_mynn.F90 (100%) rename physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.F90 (100%) rename physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.meta (99%) rename physics/{ => h2o_photo}/h2o_def.f (100%) rename physics/{ => h2o_photo}/h2o_def.meta (94%) rename physics/{ => h2o_photo}/h2ointerp.f90 (100%) rename physics/{ => h2o_photo}/h2ophys.f (100%) rename physics/{ => h2o_photo}/h2ophys.meta (98%) rename physics/{ => hooks}/machine.F (100%) rename physics/{ => hooks}/machine.meta (100%) rename physics/{ => hooks}/physcons.F90 (100%) rename physics/{ => o3_photo}/ozinterp.f90 (100%) rename physics/{ => o3_photo}/ozne_def.f (100%) rename physics/{ => o3_photo}/ozne_def.meta (95%) rename physics/{ => o3_photo}/ozphys.f (100%) rename physics/{ => o3_photo}/ozphys.meta (99%) rename physics/{ => o3_photo}/ozphys_2015.f (100%) rename physics/{ => o3_photo}/ozphys_2015.meta (99%) delete mode 160000 physics/rte-rrtmgp rename physics/{ => tools}/funcphys.f90 (100%) rename physics/{ => tools}/get_phi_fv3.F90 (100%) rename physics/{ => tools}/get_phi_fv3.meta (97%) rename physics/{ => tools}/get_prs_fv3.F90 (100%) rename physics/{ => tools}/get_prs_fv3.meta (98%) diff --git a/.gitmodules b/.gitmodules index 8758980ec..c82541c5b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "physics/rte-rrtmgp"] - path = physics/rte-rrtmgp + path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main diff --git a/physics/cu_c3_deep.F90 b/physics/CONV/CCC/cu_c3_deep.F90 similarity index 100% rename from physics/cu_c3_deep.F90 rename to physics/CONV/CCC/cu_c3_deep.F90 diff --git a/physics/cu_c3_driver.F90 b/physics/CONV/CCC/cu_c3_driver.F90 similarity index 100% rename from physics/cu_c3_driver.F90 rename to physics/CONV/CCC/cu_c3_driver.F90 diff --git a/physics/cu_c3_driver.meta b/physics/CONV/CCC/cu_c3_driver.meta similarity index 99% rename from physics/cu_c3_driver.meta rename to physics/CONV/CCC/cu_c3_driver.meta index 999b5c2bc..bb2784642 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/CONV/CCC/cu_c3_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver type = scheme - dependencies = cu_c3_deep.F90,cu_c3_sh.F90,machine.F,physcons.F90,progsigma_calc.f90 + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_driver_post.F90 b/physics/CONV/CCC/cu_c3_driver_post.F90 similarity index 100% rename from physics/cu_c3_driver_post.F90 rename to physics/CONV/CCC/cu_c3_driver_post.F90 diff --git a/physics/cu_c3_driver_post.meta b/physics/CONV/CCC/cu_c3_driver_post.meta similarity index 98% rename from physics/cu_c3_driver_post.meta rename to physics/CONV/CCC/cu_c3_driver_post.meta index c53972f09..78dca2ed4 100644 --- a/physics/cu_c3_driver_post.meta +++ b/physics/CONV/CCC/cu_c3_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_driver_pre.F90 b/physics/CONV/CCC/cu_c3_driver_pre.F90 similarity index 100% rename from physics/cu_c3_driver_pre.F90 rename to physics/CONV/CCC/cu_c3_driver_pre.F90 diff --git a/physics/cu_c3_driver_pre.meta b/physics/CONV/CCC/cu_c3_driver_pre.meta similarity index 98% rename from physics/cu_c3_driver_pre.meta rename to physics/CONV/CCC/cu_c3_driver_pre.meta index c018bee9f..a022cf743 100644 --- a/physics/cu_c3_driver_pre.meta +++ b/physics/CONV/CCC/cu_c3_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_sh.F90 b/physics/CONV/CCC/cu_c3_sh.F90 similarity index 100% rename from physics/cu_c3_sh.F90 rename to physics/CONV/CCC/cu_c3_sh.F90 diff --git a/physics/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 similarity index 100% rename from physics/cs_conv.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv.F90 diff --git a/physics/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta similarity index 99% rename from physics/cs_conv.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv.meta index fae1c91fe..49e460ed6 100644 --- a/physics/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_aw_adj.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 similarity index 100% rename from physics/cs_conv_aw_adj.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 diff --git a/physics/cs_conv_aw_adj.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta similarity index 99% rename from physics/cs_conv_aw_adj.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta index 0dada0fd5..54350dbac 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_aw_adj type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_post.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 similarity index 100% rename from physics/cs_conv_post.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 diff --git a/physics/cs_conv_post.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta similarity index 97% rename from physics/cs_conv_post.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.meta index 116ffbef4..75de3fca7 100644 --- a/physics/cs_conv_post.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_pre.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 similarity index 100% rename from physics/cs_conv_pre.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 diff --git a/physics/cs_conv_pre.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta similarity index 99% rename from physics/cs_conv_pre.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta index 2decd5f8b..7ce80496b 100644 --- a/physics/cs_conv_pre.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 similarity index 100% rename from physics/cu_gf_deep.F90 rename to physics/CONV/Grell_Freitas/cu_gf_deep.F90 diff --git a/physics/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 similarity index 100% rename from physics/cu_gf_driver.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver.F90 diff --git a/physics/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta similarity index 99% rename from physics/cu_gf_driver.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver.meta index 8b1a46e2d..d5324f05a 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver type = scheme - dependencies = cu_gf_deep.F90,cu_gf_sh.F90,machine.F,physcons.F90 + dependencies = cu_gf_deep.F90,cu_gf_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_post.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 similarity index 100% rename from physics/cu_gf_driver_post.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 diff --git a/physics/cu_gf_driver_post.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta similarity index 98% rename from physics/cu_gf_driver_post.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.meta index 48e762cb4..fe2308b1b 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_pre.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 similarity index 100% rename from physics/cu_gf_driver_pre.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 diff --git a/physics/cu_gf_driver_pre.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta similarity index 98% rename from physics/cu_gf_driver_pre.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta index 7fd66d19b..5139cae6d 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_sh.F90 b/physics/CONV/Grell_Freitas/cu_gf_sh.F90 similarity index 100% rename from physics/cu_gf_sh.F90 rename to physics/CONV/Grell_Freitas/cu_gf_sh.F90 diff --git a/physics/rascnv.F90 b/physics/CONV/RAS/rascnv.F90 similarity index 100% rename from physics/rascnv.F90 rename to physics/CONV/RAS/rascnv.F90 diff --git a/physics/rascnv.meta b/physics/CONV/RAS/rascnv.meta similarity index 99% rename from physics/rascnv.meta rename to physics/CONV/RAS/rascnv.meta index 5285c830f..f5a707ded 100644 --- a/physics/rascnv.meta +++ b/physics/CONV/RAS/rascnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rascnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/samfaerosols.F b/physics/CONV/SAMF/samfaerosols.F similarity index 100% rename from physics/samfaerosols.F rename to physics/CONV/SAMF/samfaerosols.F diff --git a/physics/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f similarity index 100% rename from physics/samfdeepcnv.f rename to physics/CONV/SAMF/samfdeepcnv.f diff --git a/physics/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta similarity index 99% rename from physics/samfdeepcnv.meta rename to physics/CONV/SAMF/samfdeepcnv.meta index bed4d655d..ec9157ef3 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfdeepcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f similarity index 100% rename from physics/samfshalcnv.f rename to physics/CONV/SAMF/samfshalcnv.f diff --git a/physics/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta similarity index 99% rename from physics/samfshalcnv.meta rename to physics/CONV/SAMF/samfshalcnv.meta index c1fffef58..aab66d625 100644 --- a/physics/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfshalcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sascnvn.F b/physics/CONV/SAS/sascnvn.F similarity index 100% rename from physics/sascnvn.F rename to physics/CONV/SAS/sascnvn.F diff --git a/physics/sascnvn.meta b/physics/CONV/SAS/sascnvn.meta similarity index 99% rename from physics/sascnvn.meta rename to physics/CONV/SAS/sascnvn.meta index 66e5161ad..fefa2823a 100644 --- a/physics/sascnvn.meta +++ b/physics/CONV/SAS/sascnvn.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sascnvn type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/shalcnv.F b/physics/CONV/SAS/shalcnv.F similarity index 100% rename from physics/shalcnv.F rename to physics/CONV/SAS/shalcnv.F diff --git a/physics/shalcnv.meta b/physics/CONV/SAS/shalcnv.meta similarity index 99% rename from physics/shalcnv.meta rename to physics/CONV/SAS/shalcnv.meta index f554201c5..15324ed08 100644 --- a/physics/shalcnv.meta +++ b/physics/CONV/SAS/shalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shalcnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 similarity index 100% rename from physics/cu_ntiedtke.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke.F90 diff --git a/physics/cu_ntiedtke.meta b/physics/CONV/nTiedtke/cu_ntiedtke.meta similarity index 99% rename from physics/cu_ntiedtke.meta rename to physics/CONV/nTiedtke/cu_ntiedtke.meta index dded8fb20..b425a80ad 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_post.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_post.F90 similarity index 100% rename from physics/cu_ntiedtke_post.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_post.F90 diff --git a/physics/cu_ntiedtke_post.meta b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta similarity index 97% rename from physics/cu_ntiedtke_post.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_post.meta index 703d32b90..9960b6b77 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_pre.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 similarity index 100% rename from physics/cu_ntiedtke_pre.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 diff --git a/physics/cu_ntiedtke_pre.meta b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta similarity index 98% rename from physics/cu_ntiedtke_pre.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.meta index ccb9b7f48..26392f0e6 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/progsigma_calc.f90 b/physics/CONV/progsigma_calc.f90 similarity index 100% rename from physics/progsigma_calc.f90 rename to physics/CONV/progsigma_calc.f90 diff --git a/physics/cires_orowam2017.f b/physics/GWD/cires_orowam2017.f similarity index 100% rename from physics/cires_orowam2017.f rename to physics/GWD/cires_orowam2017.f diff --git a/physics/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 similarity index 100% rename from physics/cires_tauamf_data.F90 rename to physics/GWD/cires_tauamf_data.F90 diff --git a/physics/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 similarity index 100% rename from physics/cires_ugwp.F90 rename to physics/GWD/cires_ugwp.F90 diff --git a/physics/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta similarity index 99% rename from physics/cires_ugwp.meta rename to physics/GWD/cires_ugwp.meta index d944a635e..cd0192ca7 100644 --- a/physics/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -3,7 +3,7 @@ type = scheme # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp-v0! dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F + dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,../hooks/machine.F,ugwp_driver_v0.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_initialize.F90 b/physics/GWD/cires_ugwp_initialize.F90 similarity index 100% rename from physics/cires_ugwp_initialize.F90 rename to physics/GWD/cires_ugwp_initialize.F90 diff --git a/physics/cires_ugwp_module.F90 b/physics/GWD/cires_ugwp_module.F90 similarity index 100% rename from physics/cires_ugwp_module.F90 rename to physics/GWD/cires_ugwp_module.F90 diff --git a/physics/cires_ugwp_post.F90 b/physics/GWD/cires_ugwp_post.F90 similarity index 100% rename from physics/cires_ugwp_post.F90 rename to physics/GWD/cires_ugwp_post.F90 diff --git a/physics/cires_ugwp_post.meta b/physics/GWD/cires_ugwp_post.meta similarity index 99% rename from physics/cires_ugwp_post.meta rename to physics/GWD/cires_ugwp_post.meta index 5add9d43f..dabc40082 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/GWD/cires_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cires_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_triggers.F90 b/physics/GWD/cires_ugwp_triggers.F90 similarity index 100% rename from physics/cires_ugwp_triggers.F90 rename to physics/GWD/cires_ugwp_triggers.F90 diff --git a/physics/cires_ugwpv1_initialize.F90 b/physics/GWD/cires_ugwpv1_initialize.F90 similarity index 100% rename from physics/cires_ugwpv1_initialize.F90 rename to physics/GWD/cires_ugwpv1_initialize.F90 diff --git a/physics/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 similarity index 100% rename from physics/cires_ugwpv1_module.F90 rename to physics/GWD/cires_ugwpv1_module.F90 diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/GWD/cires_ugwpv1_oro.F90 similarity index 100% rename from physics/cires_ugwpv1_oro.F90 rename to physics/GWD/cires_ugwpv1_oro.F90 diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/GWD/cires_ugwpv1_solv2.F90 similarity index 100% rename from physics/cires_ugwpv1_solv2.F90 rename to physics/GWD/cires_ugwpv1_solv2.F90 diff --git a/physics/cires_ugwpv1_sporo.F90 b/physics/GWD/cires_ugwpv1_sporo.F90 similarity index 100% rename from physics/cires_ugwpv1_sporo.F90 rename to physics/GWD/cires_ugwpv1_sporo.F90 diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/GWD/cires_ugwpv1_triggers.F90 similarity index 100% rename from physics/cires_ugwpv1_triggers.F90 rename to physics/GWD/cires_ugwpv1_triggers.F90 diff --git a/physics/drag_suite.F90 b/physics/GWD/drag_suite.F90 similarity index 100% rename from physics/drag_suite.F90 rename to physics/GWD/drag_suite.F90 diff --git a/physics/drag_suite.meta b/physics/GWD/drag_suite.meta similarity index 99% rename from physics/drag_suite.meta rename to physics/GWD/drag_suite.meta index 66f320b98..94dddcc93 100644 --- a/physics/drag_suite.meta +++ b/physics/GWD/drag_suite.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = drag_suite type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc.f b/physics/GWD/gwdc.f similarity index 100% rename from physics/gwdc.f rename to physics/GWD/gwdc.f diff --git a/physics/gwdc.meta b/physics/GWD/gwdc.meta similarity index 99% rename from physics/gwdc.meta rename to physics/GWD/gwdc.meta index 341879b0b..9884d8a62 100644 --- a/physics/gwdc.meta +++ b/physics/GWD/gwdc.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc_post.f b/physics/GWD/gwdc_post.f similarity index 100% rename from physics/gwdc_post.f rename to physics/GWD/gwdc_post.f diff --git a/physics/gwdc_post.meta b/physics/GWD/gwdc_post.meta similarity index 99% rename from physics/gwdc_post.meta rename to physics/GWD/gwdc_post.meta index 25415b888..97649d4cf 100644 --- a/physics/gwdc_post.meta +++ b/physics/GWD/gwdc_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc_pre.f b/physics/GWD/gwdc_pre.f similarity index 100% rename from physics/gwdc_pre.f rename to physics/GWD/gwdc_pre.f diff --git a/physics/gwdc_pre.meta b/physics/GWD/gwdc_pre.meta similarity index 99% rename from physics/gwdc_pre.meta rename to physics/GWD/gwdc_pre.meta index 63df59cfa..55b0054bd 100644 --- a/physics/gwdc_pre.meta +++ b/physics/GWD/gwdc_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdc_pre type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdps.f b/physics/GWD/gwdps.f similarity index 100% rename from physics/gwdps.f rename to physics/GWD/gwdps.f diff --git a/physics/gwdps.meta b/physics/GWD/gwdps.meta similarity index 99% rename from physics/gwdps.meta rename to physics/GWD/gwdps.meta index af60886ab..bbe7569d0 100644 --- a/physics/gwdps.meta +++ b/physics/GWD/gwdps.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdps type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f similarity index 100% rename from physics/rayleigh_damp.f rename to physics/GWD/rayleigh_damp.f diff --git a/physics/rayleigh_damp.meta b/physics/GWD/rayleigh_damp.meta similarity index 99% rename from physics/rayleigh_damp.meta rename to physics/GWD/rayleigh_damp.meta index 63025bcff..525acbe8b 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/GWD/rayleigh_damp.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rayleigh_damp type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F similarity index 100% rename from physics/ugwp_driver_v0.F rename to physics/GWD/ugwp_driver_v0.F diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 similarity index 100% rename from physics/ugwpv1_gsldrag.F90 rename to physics/GWD/ugwpv1_gsldrag.F90 diff --git a/physics/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta similarity index 99% rename from physics/ugwpv1_gsldrag.meta rename to physics/GWD/ugwpv1_gsldrag.meta index 82caa8832..73d7eee1c 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag type = scheme - dependencies = machine.F,drag_suite.F90 + dependencies = ../hooks/machine.F,drag_suite.F90 dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90 dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 ######################################################################## diff --git a/physics/ugwpv1_gsldrag_post.F90 b/physics/GWD/ugwpv1_gsldrag_post.F90 similarity index 100% rename from physics/ugwpv1_gsldrag_post.F90 rename to physics/GWD/ugwpv1_gsldrag_post.F90 diff --git a/physics/ugwpv1_gsldrag_post.meta b/physics/GWD/ugwpv1_gsldrag_post.meta similarity index 99% rename from physics/ugwpv1_gsldrag_post.meta rename to physics/GWD/ugwpv1_gsldrag_post.meta index f8766060c..e1c63102d 100644 --- a/physics/ugwpv1_gsldrag_post.meta +++ b/physics/GWD/ugwpv1_gsldrag_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 similarity index 100% rename from physics/unified_ugwp.F90 rename to physics/GWD/unified_ugwp.F90 diff --git a/physics/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta similarity index 99% rename from physics/unified_ugwp.meta rename to physics/GWD/unified_ugwp.meta index 8af99957a..a08ee3960 100644 --- a/physics/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - - dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f, cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F - dependencies=drag_suite.F90 + dependencies = ../hooks/machine.F + dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 + dependencies = cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,ugwp_driver_v0.F + dependencies = drag_suite.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/unified_ugwp_post.F90 b/physics/GWD/unified_ugwp_post.F90 similarity index 100% rename from physics/unified_ugwp_post.F90 rename to physics/GWD/unified_ugwp_post.F90 diff --git a/physics/unified_ugwp_post.meta b/physics/GWD/unified_ugwp_post.meta similarity index 99% rename from physics/unified_ugwp_post.meta rename to physics/GWD/unified_ugwp_post.meta index 6da6342df..7784c28ec 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/GWD/unified_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = unified_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_DCNV_generic_post.F90 b/physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 similarity index 100% rename from physics/GFS_DCNV_generic_post.F90 rename to physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 diff --git a/physics/GFS_DCNV_generic_post.meta b/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta similarity index 99% rename from physics/GFS_DCNV_generic_post.meta rename to physics/Interstitials/GFS/GFS_DCNV_generic_post.meta index 8428752ce..359e580fe 100644 --- a/physics/GFS_DCNV_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 similarity index 100% rename from physics/GFS_DCNV_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 diff --git a/physics/GFS_DCNV_generic_pre.meta b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta similarity index 99% rename from physics/GFS_DCNV_generic_pre.meta rename to physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta index ee2050926..46de572f0 100644 --- a/physics/GFS_DCNV_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_GWD_generic_post.F90 b/physics/Interstitials/GFS/GFS_GWD_generic_post.F90 similarity index 100% rename from physics/GFS_GWD_generic_post.F90 rename to physics/Interstitials/GFS/GFS_GWD_generic_post.F90 diff --git a/physics/GFS_GWD_generic_post.meta b/physics/Interstitials/GFS/GFS_GWD_generic_post.meta similarity index 99% rename from physics/GFS_GWD_generic_post.meta rename to physics/Interstitials/GFS/GFS_GWD_generic_post.meta index 204c16c84..beca39282 100644 --- a/physics/GFS_GWD_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_GWD_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_GWD_generic_pre.F90 b/physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 similarity index 100% rename from physics/GFS_GWD_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 diff --git a/physics/GFS_GWD_generic_pre.meta b/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta similarity index 99% rename from physics/GFS_GWD_generic_pre.meta rename to physics/Interstitials/GFS/GFS_GWD_generic_pre.meta index 9bcc03300..dbbfc261d 100644 --- a/physics/GFS_GWD_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_MP_generic_post.F90 b/physics/Interstitials/GFS/GFS_MP_generic_post.F90 similarity index 100% rename from physics/GFS_MP_generic_post.F90 rename to physics/Interstitials/GFS/GFS_MP_generic_post.F90 diff --git a/physics/GFS_MP_generic_post.meta b/physics/Interstitials/GFS/GFS_MP_generic_post.meta similarity index 99% rename from physics/GFS_MP_generic_post.meta rename to physics/Interstitials/GFS/GFS_MP_generic_post.meta index 7cd2ca4b5..0ac5c4527 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_MP_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_MP_generic_post type = scheme - dependencies = calpreciptype.f90,machine.F + dependencies = ../../MP/calpreciptype.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_MP_generic_pre.F90 b/physics/Interstitials/GFS/GFS_MP_generic_pre.F90 similarity index 100% rename from physics/GFS_MP_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_MP_generic_pre.F90 diff --git a/physics/GFS_MP_generic_pre.meta b/physics/Interstitials/GFS/GFS_MP_generic_pre.meta similarity index 98% rename from physics/GFS_MP_generic_pre.meta rename to physics/Interstitials/GFS/GFS_MP_generic_pre.meta index a2a4947ef..6d5fd1538 100644 --- a/physics/GFS_MP_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_MP_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_MP_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic_common.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_common.F90 similarity index 100% rename from physics/GFS_PBL_generic_common.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_common.F90 diff --git a/physics/GFS_PBL_generic_post.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_post.F90 similarity index 100% rename from physics/GFS_PBL_generic_post.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_post.F90 diff --git a/physics/GFS_PBL_generic_post.meta b/physics/Interstitials/GFS/GFS_PBL_generic_post.meta similarity index 99% rename from physics/GFS_PBL_generic_post.meta rename to physics/Interstitials/GFS/GFS_PBL_generic_post.meta index b20142991..53a769c49 100644 --- a/physics/GFS_PBL_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_PBL_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_post type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic_pre.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 similarity index 100% rename from physics/GFS_PBL_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 diff --git a/physics/GFS_PBL_generic_pre.meta b/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta similarity index 99% rename from physics/GFS_PBL_generic_pre.meta rename to physics/Interstitials/GFS/GFS_PBL_generic_pre.meta index a09b34b48..0377582a4 100644 --- a/physics/GFS_PBL_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_pre type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_SCNV_generic_post.F90 b/physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 similarity index 100% rename from physics/GFS_SCNV_generic_post.F90 rename to physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 diff --git a/physics/GFS_SCNV_generic_post.meta b/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta similarity index 99% rename from physics/GFS_SCNV_generic_post.meta rename to physics/Interstitials/GFS/GFS_SCNV_generic_post.meta index bf6ba394f..963ad4a81 100644 --- a/physics/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 similarity index 100% rename from physics/GFS_SCNV_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 diff --git a/physics/GFS_SCNV_generic_pre.meta b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta similarity index 99% rename from physics/GFS_SCNV_generic_pre.meta rename to physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta index eccd547a1..fbd9e47d8 100644 --- a/physics/GFS_SCNV_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 similarity index 100% rename from physics/GFS_cloud_diagnostics.F90 rename to physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta similarity index 98% rename from physics/GFS_cloud_diagnostics.meta rename to physics/Interstitials/GFS/GFS_cloud_diagnostics.meta index 53d1552e6..576c66463 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_cloud_diagnostics type = scheme - dependencies = machine.F,radiation_clouds.f + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/radiation_clouds.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_debug.F90 b/physics/Interstitials/GFS/GFS_debug.F90 similarity index 100% rename from physics/GFS_debug.F90 rename to physics/Interstitials/GFS/GFS_debug.F90 diff --git a/physics/GFS_debug.meta b/physics/Interstitials/GFS/GFS_debug.meta similarity index 99% rename from physics/GFS_debug.meta rename to physics/Interstitials/GFS/GFS_debug.meta index 1ad24e1d6..de3f49a6f 100644 --- a/physics/GFS_debug.meta +++ b/physics/Interstitials/GFS/GFS_debug.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_diagtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 similarity index 100% rename from physics/GFS_phys_time_vary.fv3.F90 rename to physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta similarity index 98% rename from physics/GFS_phys_time_vary.fv3.meta rename to physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta index 363469e91..45125385c 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta @@ -1,8 +1,15 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f + dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 similarity index 100% rename from physics/GFS_phys_time_vary.scm.F90 rename to physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta similarity index 98% rename from physics/GFS_phys_time_vary.scm.meta rename to physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta index 8b59e4bed..84f22aede 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta @@ -1,8 +1,15 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f + dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 similarity index 100% rename from physics/GFS_rad_time_vary.fv3.F90 rename to physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta similarity index 98% rename from physics/GFS_rad_time_vary.fv3.meta rename to physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta index 19eb41dc2..0759b7e2a 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 similarity index 100% rename from physics/GFS_rad_time_vary.scm.F90 rename to physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta similarity index 98% rename from physics/GFS_rad_time_vary.scm.meta rename to physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta index 19eb41dc2..0759b7e2a 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_radiation_surface.F90 b/physics/Interstitials/GFS/GFS_radiation_surface.F90 similarity index 100% rename from physics/GFS_radiation_surface.F90 rename to physics/Interstitials/GFS/GFS_radiation_surface.F90 diff --git a/physics/GFS_radiation_surface.meta b/physics/Interstitials/GFS/GFS_radiation_surface.meta similarity index 98% rename from physics/GFS_radiation_surface.meta rename to physics/Interstitials/GFS/GFS_radiation_surface.meta index 9d5734706..c18b81d9f 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/Interstitials/GFS/GFS_radiation_surface.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_radiation_surface type = scheme - dependencies = iounitdef.f,machine.F,radiation_surface.f,set_soilveg_ruc.F90,namelist_soilveg_ruc.F90 + relative_path = ../../ + dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f + dependencies = Land/RUC/set_soilveg_ruc.F90,Land/RUC/namelist_soilveg_ruc.F90 + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_post.F90 b/physics/Interstitials/GFS/GFS_rrtmg_post.F90 similarity index 100% rename from physics/GFS_rrtmg_post.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_post.F90 diff --git a/physics/GFS_rrtmg_post.meta b/physics/Interstitials/GFS/GFS_rrtmg_post.meta similarity index 97% rename from physics/GFS_rrtmg_post.meta rename to physics/Interstitials/GFS/GFS_rrtmg_post.meta index 5fa6328a7..c84b9da31 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmg_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radsw_param.f + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/Interstitials/GFS/GFS_rrtmg_pre.F90 similarity index 100% rename from physics/GFS_rrtmg_pre.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_pre.F90 diff --git a/physics/GFS_rrtmg_pre.meta b/physics/Interstitials/GFS/GFS_rrtmg_pre.meta similarity index 98% rename from physics/GFS_rrtmg_pre.meta rename to physics/Interstitials/GFS/GFS_rrtmg_pre.meta index a8aecdbe0..e0e67c8f5 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_pre.meta @@ -1,9 +1,13 @@ [ccpp-table-properties] name = GFS_rrtmg_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90 - dependencies = module_mp_thompson_make_number_concentrations.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90,radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompsonmodule_mp_thompson_make_number_concentrations.F90 + dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 + dependencies = Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/Interstitials/GFS/GFS_rrtmg_setup.F90 similarity index 100% rename from physics/GFS_rrtmg_setup.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_setup.F90 diff --git a/physics/GFS_rrtmg_setup.meta b/physics/Interstitials/GFS/GFS_rrtmg_setup.meta similarity index 97% rename from physics/GFS_rrtmg_setup.meta rename to physics/Interstitials/GFS/GFS_rrtmg_setup.meta index adf6d8750..0c199deaa 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_setup.meta @@ -1,8 +1,12 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f - dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f,machine.F + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiaiton/iounitdef.f,Radiaiton/RRTMG/radcons.f90,Radiaiton/radiation_aerosols.f + dependencies = Radiaiton/radiation_astronomy.f,Radiaiton/radiation_clouds.f,Radiaiton/radiation_gases.f + dependencies = Radiaiton/radlw_main.F90,Radiaiton/radlw_param.f,Radiaiton/radsw_main.F90,Radiaiton/radsw_param.f + dependencies = MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 similarity index 100% rename from physics/GFS_rrtmgp_cloud_mp.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta similarity index 98% rename from physics/GFS_rrtmgp_cloud_mp.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta index b782e73b4..f67259b87 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_mp type = scheme - dependencies = radiation_tools.F90, radiation_clouds.f, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_clouds.f,Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 similarity index 100% rename from physics/GFS_rrtmgp_cloud_overlap.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 diff --git a/physics/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta similarity index 98% rename from physics/GFS_rrtmgp_cloud_overlap.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta index cf6a05217..4d9af626d 100644 --- a/physics/GFS_rrtmgp_cloud_overlap.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_overlap type = scheme - dependencies = radiation_tools.F90, radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_post.F90 similarity index 100% rename from physics/GFS_rrtmgp_post.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_post.F90 diff --git a/physics/GFS_rrtmgp_post.meta b/physics/Interstitials/GFS/GFS_rrtmgp_post.meta similarity index 98% rename from physics/GFS_rrtmgp_post.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_post.meta index e4bc3e5dc..c21c2ef7c 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + relative_path = ../../ + dependencies = Radiation/iounitdef.f,hooks/machine.F,Radiation/radiation_aerosols.f + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 similarity index 99% rename from physics/GFS_rrtmgp_pre.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 index 009eb8c38..b76f93659 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 @@ -9,7 +9,6 @@ module GFS_rrtmgp_pre use funcphys, only: fpvs use module_radiation_astronomy, only: coszmn use module_radiation_gases, only: NF_VGAS, getgases, getozn - use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev use rrtmgp_lw_gas_optics, only: lw_gas_props diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta similarity index 98% rename from physics/GFS_rrtmgp_pre.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_pre.meta index abb07b825..ae67ef51b 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 similarity index 100% rename from physics/GFS_rrtmgp_setup.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta similarity index 97% rename from physics/GFS_rrtmgp_setup.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_setup.meta index c4f7cfaa5..5d21e1910 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta @@ -1,8 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_setup type = scheme - dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_gases.f + relative_path = ../../ + dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 + dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_stochastics.F90 b/physics/Interstitials/GFS/GFS_stochastics.F90 similarity index 100% rename from physics/GFS_stochastics.F90 rename to physics/Interstitials/GFS/GFS_stochastics.F90 diff --git a/physics/GFS_stochastics.meta b/physics/Interstitials/GFS/GFS_stochastics.meta similarity index 99% rename from physics/GFS_stochastics.meta rename to physics/Interstitials/GFS/GFS_stochastics.meta index 796f4ddf7..6c55a09de 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/Interstitials/GFS/GFS_stochastics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_stochastics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = GFS_stochastics_init diff --git a/physics/GFS_suite_interstitial_1.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 similarity index 100% rename from physics/GFS_suite_interstitial_1.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 diff --git a/physics/GFS_suite_interstitial_1.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta similarity index 99% rename from physics/GFS_suite_interstitial_1.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_1.meta index a465ed320..295ffdf2e 100644 --- a/physics/GFS_suite_interstitial_1.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_2.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 similarity index 100% rename from physics/GFS_suite_interstitial_2.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 diff --git a/physics/GFS_suite_interstitial_2.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta similarity index 99% rename from physics/GFS_suite_interstitial_2.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_2.meta index 1f4300574..de4db5f9f 100644 --- a/physics/GFS_suite_interstitial_2.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_3.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 similarity index 100% rename from physics/GFS_suite_interstitial_3.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 diff --git a/physics/GFS_suite_interstitial_3.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta similarity index 99% rename from physics/GFS_suite_interstitial_3.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_3.meta index e8f9fe889..22f57e354 100644 --- a/physics/GFS_suite_interstitial_3.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_3 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_4.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 similarity index 100% rename from physics/GFS_suite_interstitial_4.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 diff --git a/physics/GFS_suite_interstitial_4.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta similarity index 98% rename from physics/GFS_suite_interstitial_4.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_4.meta index 92870d95f..c0df52f1a 100644 --- a/physics/GFS_suite_interstitial_4.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta @@ -2,7 +2,9 @@ [ccpp-table-properties] name = GFS_suite_interstitial_4 type = scheme - dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_5.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 similarity index 100% rename from physics/GFS_suite_interstitial_5.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 diff --git a/physics/GFS_suite_interstitial_5.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta similarity index 98% rename from physics/GFS_suite_interstitial_5.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_5.meta index 9d32160a1..511137901 100644 --- a/physics/GFS_suite_interstitial_5.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_5 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_phys_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 diff --git a/physics/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_phys_reset.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta index adebbc833..947a1950f 100644 --- a/physics/GFS_suite_interstitial_phys_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_phys_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_rad_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 diff --git a/physics/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_rad_reset.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta index 91fd8cba7..aaaff02f5 100644 --- a/physics/GFS_suite_interstitial_rad_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_rad_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_stateout_reset.F90 b/physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 similarity index 100% rename from physics/GFS_suite_stateout_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 diff --git a/physics/GFS_suite_stateout_reset.meta b/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta similarity index 98% rename from physics/GFS_suite_stateout_reset.meta rename to physics/Interstitials/GFS/GFS_suite_stateout_reset.meta index fa4111e6b..b84d10691 100644 --- a/physics/GFS_suite_stateout_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/Interstitials/GFS/GFS_suite_stateout_update.F90 similarity index 100% rename from physics/GFS_suite_stateout_update.F90 rename to physics/Interstitials/GFS/GFS_suite_stateout_update.F90 diff --git a/physics/GFS_suite_stateout_update.meta b/physics/Interstitials/GFS/GFS_suite_stateout_update.meta similarity index 99% rename from physics/GFS_suite_stateout_update.meta rename to physics/Interstitials/GFS/GFS_suite_stateout_update.meta index 580482b71..8a0d784f2 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/GFS/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/Interstitials/GFS/GFS_surface_composites_inter.F90 similarity index 100% rename from physics/GFS_surface_composites_inter.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_inter.F90 diff --git a/physics/GFS_surface_composites_inter.meta b/physics/Interstitials/GFS/GFS_surface_composites_inter.meta similarity index 99% rename from physics/GFS_surface_composites_inter.meta rename to physics/Interstitials/GFS/GFS_surface_composites_inter.meta index 36af0ef5a..ef3005583 100644 --- a/physics/GFS_surface_composites_inter.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_inter.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_composites_inter type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_post.F90 b/physics/Interstitials/GFS/GFS_surface_composites_post.F90 similarity index 100% rename from physics/GFS_surface_composites_post.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_post.F90 diff --git a/physics/GFS_surface_composites_post.meta b/physics/Interstitials/GFS/GFS_surface_composites_post.meta similarity index 99% rename from physics/GFS_surface_composites_post.meta rename to physics/Interstitials/GFS/GFS_surface_composites_post.meta index a78610cc7..35b54544a 100644 --- a/physics/GFS_surface_composites_post.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_post.meta @@ -2,7 +2,8 @@ [ccpp-table-properties] name = GFS_surface_composites_post type = scheme - dependencies = machine.F,sfc_diff.f + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Layer/GFS_sfc/sfc_diff.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/Interstitials/GFS/GFS_surface_composites_pre.F90 similarity index 100% rename from physics/GFS_surface_composites_pre.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_pre.F90 diff --git a/physics/GFS_surface_composites_pre.meta b/physics/Interstitials/GFS/GFS_surface_composites_pre.meta similarity index 99% rename from physics/GFS_surface_composites_pre.meta rename to physics/Interstitials/GFS/GFS_surface_composites_pre.meta index d6b9003fe..33e2f0523 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_composites_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_generic_post.F90 b/physics/Interstitials/GFS/GFS_surface_generic_post.F90 similarity index 100% rename from physics/GFS_surface_generic_post.F90 rename to physics/Interstitials/GFS/GFS_surface_generic_post.F90 diff --git a/physics/GFS_surface_generic_post.meta b/physics/Interstitials/GFS/GFS_surface_generic_post.meta similarity index 99% rename from physics/GFS_surface_generic_post.meta rename to physics/Interstitials/GFS/GFS_surface_generic_post.meta index 9658be7d8..2c28b17d7 100644 --- a/physics/GFS_surface_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_surface_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_generic_pre.F90 b/physics/Interstitials/GFS/GFS_surface_generic_pre.F90 similarity index 100% rename from physics/GFS_surface_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_surface_generic_pre.F90 diff --git a/physics/GFS_surface_generic_pre.meta b/physics/Interstitials/GFS/GFS_surface_generic_pre.meta similarity index 99% rename from physics/GFS_surface_generic_pre.meta rename to physics/Interstitials/GFS/GFS_surface_generic_pre.meta index d78988787..63fb9b96c 100644 --- a/physics/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_surface_generic_pre.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_surface_generic_pre type = scheme - dependencies = machine.F,surface_perturbation.F90 + relative_path = ../../ + dependencies = hooks/machine.F,Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part1.F90 rename to physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 diff --git a/physics/GFS_surface_loop_control_part1.meta b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta similarity index 97% rename from physics/GFS_surface_loop_control_part1.meta rename to physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta index f178320ee..4bf962f6e 100644 --- a/physics/GFS_surface_loop_control_part1.meta +++ b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control_part2.F90 b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part2.F90 rename to physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 diff --git a/physics/GFS_surface_loop_control_part2.meta b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta similarity index 98% rename from physics/GFS_surface_loop_control_part2.meta rename to physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta index 7c9bc7408..ba19bf437 100644 --- a/physics/GFS_surface_loop_control_part2.meta +++ b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 similarity index 100% rename from physics/GFS_time_vary_pre.fv3.F90 rename to physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta similarity index 98% rename from physics/GFS_time_vary_pre.fv3.meta rename to physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta index 3ec92287a..c6dd95bce 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 similarity index 100% rename from physics/GFS_time_vary_pre.scm.F90 rename to physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta similarity index 98% rename from physics/GFS_time_vary_pre.scm.meta rename to physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta index 20708c51e..af9afcdfe 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/aerinterp.F90 b/physics/Interstitials/GFS/aerinterp.F90 similarity index 100% rename from physics/aerinterp.F90 rename to physics/Interstitials/GFS/aerinterp.F90 diff --git a/physics/cnvc90.f b/physics/Interstitials/GFS/cnvc90.f similarity index 100% rename from physics/cnvc90.f rename to physics/Interstitials/GFS/cnvc90.f diff --git a/physics/cnvc90.meta b/physics/Interstitials/GFS/cnvc90.meta similarity index 98% rename from physics/cnvc90.meta rename to physics/Interstitials/GFS/cnvc90.meta index 9728266d4..bbf161eb5 100644 --- a/physics/cnvc90.meta +++ b/physics/Interstitials/GFS/cnvc90.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cnvc90 type = scheme - dependencies = + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/dcyc2t3.f b/physics/Interstitials/GFS/dcyc2t3.f similarity index 100% rename from physics/dcyc2t3.f rename to physics/Interstitials/GFS/dcyc2t3.f diff --git a/physics/dcyc2t3.meta b/physics/Interstitials/GFS/dcyc2t3.meta similarity index 99% rename from physics/dcyc2t3.meta rename to physics/Interstitials/GFS/dcyc2t3.meta index 65b05f4b3..95b3f341b 100644 --- a/physics/dcyc2t3.meta +++ b/physics/Interstitials/GFS/dcyc2t3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = dcyc2t3 type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gcycle.F90 b/physics/Interstitials/GFS/gcycle.F90 similarity index 100% rename from physics/gcycle.F90 rename to physics/Interstitials/GFS/gcycle.F90 diff --git a/physics/iccn_def.F b/physics/Interstitials/GFS/iccn_def.F similarity index 100% rename from physics/iccn_def.F rename to physics/Interstitials/GFS/iccn_def.F diff --git a/physics/iccninterp.F90 b/physics/Interstitials/GFS/iccninterp.F90 similarity index 100% rename from physics/iccninterp.F90 rename to physics/Interstitials/GFS/iccninterp.F90 diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 similarity index 100% rename from physics/maximum_hourly_diagnostics.F90 rename to physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta similarity index 99% rename from physics/maximum_hourly_diagnostics.meta rename to physics/Interstitials/GFS/maximum_hourly_diagnostics.meta index e9d0876d2..0c2d1bcbe 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = maximum_hourly_diagnostics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/phys_tend.F90 b/physics/Interstitials/GFS/phys_tend.F90 similarity index 100% rename from physics/phys_tend.F90 rename to physics/Interstitials/GFS/phys_tend.F90 diff --git a/physics/phys_tend.meta b/physics/Interstitials/GFS/phys_tend.meta similarity index 98% rename from physics/phys_tend.meta rename to physics/Interstitials/GFS/phys_tend.meta index 0f78af20b..d2a7bcf6b 100644 --- a/physics/phys_tend.meta +++ b/physics/Interstitials/GFS/phys_tend.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = phys_tend type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/Interstitials/GFS/scm_sfc_flux_spec.F90 similarity index 100% rename from physics/scm_sfc_flux_spec.F90 rename to physics/Interstitials/GFS/scm_sfc_flux_spec.F90 diff --git a/physics/scm_sfc_flux_spec.meta b/physics/Interstitials/GFS/scm_sfc_flux_spec.meta similarity index 99% rename from physics/scm_sfc_flux_spec.meta rename to physics/Interstitials/GFS/scm_sfc_flux_spec.meta index 52722f1c4..85bf403ad 100644 --- a/physics/scm_sfc_flux_spec.meta +++ b/physics/Interstitials/GFS/scm_sfc_flux_spec.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = scm_sfc_flux_spec type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfcsub.F b/physics/Interstitials/GFS/sfcsub.F similarity index 100% rename from physics/sfcsub.F rename to physics/Interstitials/GFS/sfcsub.F diff --git a/physics/sgscloud_radpost.F90 b/physics/Interstitials/GFS/sgscloud_radpost.F90 similarity index 100% rename from physics/sgscloud_radpost.F90 rename to physics/Interstitials/GFS/sgscloud_radpost.F90 diff --git a/physics/sgscloud_radpost.meta b/physics/Interstitials/GFS/sgscloud_radpost.meta similarity index 98% rename from physics/sgscloud_radpost.meta rename to physics/Interstitials/GFS/sgscloud_radpost.meta index 6ad91d496..046531a0a 100644 --- a/physics/sgscloud_radpost.meta +++ b/physics/Interstitials/GFS/sgscloud_radpost.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sgscloud_radpost type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sgscloud_radpre.F90 b/physics/Interstitials/GFS/sgscloud_radpre.F90 similarity index 100% rename from physics/sgscloud_radpre.F90 rename to physics/Interstitials/GFS/sgscloud_radpre.F90 diff --git a/physics/sgscloud_radpre.meta b/physics/Interstitials/GFS/sgscloud_radpre.meta similarity index 98% rename from physics/sgscloud_radpre.meta rename to physics/Interstitials/GFS/sgscloud_radpre.meta index d5341bcd4..c9fd5950c 100644 --- a/physics/sgscloud_radpre.meta +++ b/physics/Interstitials/GFS/sgscloud_radpre.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = sgscloud_radpre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f,module_mp_thompson.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,Radiation/iounitdef.f,hooks/machine.F,hooks/physcons.F90 + dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 + dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/clm_lake.f90 b/physics/Land/CLM_lake/clm_lake.f90 similarity index 100% rename from physics/clm_lake.f90 rename to physics/Land/CLM_lake/clm_lake.f90 diff --git a/physics/clm_lake.meta b/physics/Land/CLM_lake/clm_lake.meta similarity index 99% rename from physics/clm_lake.meta rename to physics/Land/CLM_lake/clm_lake.meta index bbaaded16..49564f66c 100644 --- a/physics/clm_lake.meta +++ b/physics/Land/CLM_lake/clm_lake.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = clm_lake type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/flake.F90 b/physics/Land/Flake/flake.F90 similarity index 100% rename from physics/flake.F90 rename to physics/Land/Flake/flake.F90 diff --git a/physics/flake_driver.F90 b/physics/Land/Flake/flake_driver.F90 similarity index 100% rename from physics/flake_driver.F90 rename to physics/Land/Flake/flake_driver.F90 diff --git a/physics/flake_driver.meta b/physics/Land/Flake/flake_driver.meta similarity index 99% rename from physics/flake_driver.meta rename to physics/Land/Flake/flake_driver.meta index e665dc962..8b295bc27 100644 --- a/physics/flake_driver.meta +++ b/physics/Land/Flake/flake_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = flake_driver type = scheme - dependencies = flake.F90,machine.F + dependencies = ../../hooks/machine.F,flake.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/lsm_noah.f b/physics/Land/Noah/lsm_noah.f similarity index 100% rename from physics/lsm_noah.f rename to physics/Land/Noah/lsm_noah.f diff --git a/physics/lsm_noah.meta b/physics/Land/Noah/lsm_noah.meta similarity index 99% rename from physics/lsm_noah.meta rename to physics/Land/Noah/lsm_noah.meta index e059a22c6..2dc612d5b 100644 --- a/physics/lsm_noah.meta +++ b/physics/Land/Noah/lsm_noah.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_noah type = scheme - dependencies = funcphys.f90,machine.F,set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sflx.f b/physics/Land/Noah/sflx.f similarity index 100% rename from physics/sflx.f rename to physics/Land/Noah/sflx.f diff --git a/physics/surface_perturbation.F90 b/physics/Land/Noah/surface_perturbation.F90 similarity index 100% rename from physics/surface_perturbation.F90 rename to physics/Land/Noah/surface_perturbation.F90 diff --git a/physics/module_sf_noahmp_glacier.F90 b/physics/Land/Noahmp/module_sf_noahmp_glacier.F90 similarity index 100% rename from physics/module_sf_noahmp_glacier.F90 rename to physics/Land/Noahmp/module_sf_noahmp_glacier.F90 diff --git a/physics/module_sf_noahmplsm.F90 b/physics/Land/Noahmp/module_sf_noahmplsm.F90 similarity index 100% rename from physics/module_sf_noahmplsm.F90 rename to physics/Land/Noahmp/module_sf_noahmplsm.F90 diff --git a/physics/noahmp_tables.f90 b/physics/Land/Noahmp/noahmp_tables.f90 similarity index 100% rename from physics/noahmp_tables.f90 rename to physics/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/noahmpdrv.F90 b/physics/Land/Noahmp/noahmpdrv.F90 similarity index 100% rename from physics/noahmpdrv.F90 rename to physics/Land/Noahmp/noahmpdrv.F90 diff --git a/physics/noahmpdrv.meta b/physics/Land/Noahmp/noahmpdrv.meta similarity index 99% rename from physics/noahmpdrv.meta rename to physics/Land/Noahmp/noahmpdrv.meta index 820da5740..55a787cd7 100644 --- a/physics/noahmpdrv.meta +++ b/physics/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = funcphys.f90,machine.F,sfc_diff.f,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,set_soilveg.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f ######################################################################## [ccpp-arg-table] diff --git a/physics/noahmptable.tbl b/physics/Land/Noahmp/noahmptable.tbl similarity index 100% rename from physics/noahmptable.tbl rename to physics/Land/Noahmp/noahmptable.tbl diff --git a/physics/lsm_ruc.F90 b/physics/Land/RUC/lsm_ruc.F90 similarity index 100% rename from physics/lsm_ruc.F90 rename to physics/Land/RUC/lsm_ruc.F90 diff --git a/physics/lsm_ruc.meta b/physics/Land/RUC/lsm_ruc.meta similarity index 99% rename from physics/lsm_ruc.meta rename to physics/Land/RUC/lsm_ruc.meta index 34a5b8a8b..f02d6de67 100644 --- a/physics/lsm_ruc.meta +++ b/physics/Land/RUC/lsm_ruc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 + dependencies = ../../hooks/machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_ruclsm.F90 b/physics/Land/RUC/module_sf_ruclsm.F90 similarity index 100% rename from physics/module_sf_ruclsm.F90 rename to physics/Land/RUC/module_sf_ruclsm.F90 diff --git a/physics/module_soil_pre.F90 b/physics/Land/RUC/module_soil_pre.F90 similarity index 100% rename from physics/module_soil_pre.F90 rename to physics/Land/RUC/module_soil_pre.F90 diff --git a/physics/namelist_soilveg_ruc.F90 b/physics/Land/RUC/namelist_soilveg_ruc.F90 similarity index 100% rename from physics/namelist_soilveg_ruc.F90 rename to physics/Land/RUC/namelist_soilveg_ruc.F90 diff --git a/physics/set_soilveg_ruc.F90 b/physics/Land/RUC/set_soilveg_ruc.F90 similarity index 100% rename from physics/set_soilveg_ruc.F90 rename to physics/Land/RUC/set_soilveg_ruc.F90 diff --git a/physics/namelist_soilveg.f b/physics/Land/namelist_soilveg.f similarity index 100% rename from physics/namelist_soilveg.f rename to physics/Land/namelist_soilveg.f diff --git a/physics/set_soilveg.f b/physics/Land/set_soilveg.f similarity index 100% rename from physics/set_soilveg.f rename to physics/Land/set_soilveg.f diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 similarity index 100% rename from physics/module_MP_FER_HIRES.F90 rename to physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 diff --git a/physics/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 similarity index 100% rename from physics/mp_fer_hires.F90 rename to physics/MP/Ferrier_Aligo/mp_fer_hires.F90 diff --git a/physics/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta similarity index 99% rename from physics/mp_fer_hires.meta rename to physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 9f7c63d4d..0f7be213e 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_fer_hires type = scheme - dependencies = machine.F,module_MP_FER_HIRES.F90 + dependencies = ../../hooks/machine.F,module_MP_FER_HIRES.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFDL_parse_tracers.F90 b/physics/MP/GFDL/GFDL_parse_tracers.F90 similarity index 100% rename from physics/GFDL_parse_tracers.F90 rename to physics/MP/GFDL/GFDL_parse_tracers.F90 diff --git a/physics/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 similarity index 100% rename from physics/fv_sat_adj.F90 rename to physics/MP/GFDL/fv_sat_adj.F90 diff --git a/physics/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta similarity index 99% rename from physics/fv_sat_adj.meta rename to physics/MP/GFDL/fv_sat_adj.meta index 5cdc96358..8c3c9be42 100644 --- a/physics/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = machine.F,module_gfdl_cloud_microphys.F90,module_mp_radar.F90,multi_gases.F90,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_gfdl_cloud_microphys.F90,multi_gases.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/MP/GFDL/gfdl_cloud_microphys.F90 similarity index 100% rename from physics/gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/gfdl_cloud_microphys.F90 diff --git a/physics/gfdl_cloud_microphys.meta b/physics/MP/GFDL/gfdl_cloud_microphys.meta similarity index 99% rename from physics/gfdl_cloud_microphys.meta rename to physics/MP/GFDL/gfdl_cloud_microphys.meta index 5e752b473..35b216d4a 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/gfdl_cloud_microphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = machine.F,module_mp_radar.F90,module_gfdl_cloud_microphys.F90 + dependencies = ../../hooks/machine.F,module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_sfc_layer.F90 b/physics/MP/GFDL/gfdl_sfc_layer.F90 similarity index 100% rename from physics/gfdl_sfc_layer.F90 rename to physics/MP/GFDL/gfdl_sfc_layer.F90 diff --git a/physics/gfdl_sfc_layer.meta b/physics/MP/GFDL/gfdl_sfc_layer.meta similarity index 99% rename from physics/gfdl_sfc_layer.meta rename to physics/MP/GFDL/gfdl_sfc_layer.meta index f1c7a4ce2..a64fe277c 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/MP/GFDL/gfdl_sfc_layer.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - dependencies = machine.F,module_sf_exchcoef.f90,namelist_soilveg_ruc.F90,noahmp_tables.f90 + dependencies = ../../hooks/machine.F,../SFC_Layer/module_sf_exchcoef.f90,../../Land/RUC/namelist_soilveg_ruc.F90,../../Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 similarity index 100% rename from physics/module_gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/module_gfdl_cloud_microphys.F90 diff --git a/physics/module_sf_exchcoef.f90 b/physics/MP/GFDL/module_sf_exchcoef.f90 similarity index 100% rename from physics/module_sf_exchcoef.f90 rename to physics/MP/GFDL/module_sf_exchcoef.f90 diff --git a/physics/multi_gases.F90 b/physics/MP/GFDL/multi_gases.F90 similarity index 100% rename from physics/multi_gases.F90 rename to physics/MP/GFDL/multi_gases.F90 diff --git a/physics/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F similarity index 100% rename from physics/aer_cloud.F rename to physics/MP/Morrison_Gettelman/aer_cloud.F diff --git a/physics/aerclm_def.F b/physics/MP/Morrison_Gettelman/aerclm_def.F similarity index 100% rename from physics/aerclm_def.F rename to physics/MP/Morrison_Gettelman/aerclm_def.F diff --git a/physics/cldmacro.F b/physics/MP/Morrison_Gettelman/cldmacro.F similarity index 100% rename from physics/cldmacro.F rename to physics/MP/Morrison_Gettelman/cldmacro.F diff --git a/physics/cldwat2m_micro.F b/physics/MP/Morrison_Gettelman/cldwat2m_micro.F similarity index 100% rename from physics/cldwat2m_micro.F rename to physics/MP/Morrison_Gettelman/cldwat2m_micro.F diff --git a/physics/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 similarity index 100% rename from physics/m_micro.F90 rename to physics/MP/Morrison_Gettelman/m_micro.F90 diff --git a/physics/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta similarity index 99% rename from physics/m_micro.meta rename to physics/MP/Morrison_Gettelman/m_micro.meta index a9b5ec4db..4b6df18c7 100644 --- a/physics/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F,machine.F + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro_post.F90 b/physics/MP/Morrison_Gettelman/m_micro_post.F90 similarity index 100% rename from physics/m_micro_post.F90 rename to physics/MP/Morrison_Gettelman/m_micro_post.F90 diff --git a/physics/m_micro_post.meta b/physics/MP/Morrison_Gettelman/m_micro_post.meta similarity index 99% rename from physics/m_micro_post.meta rename to physics/MP/Morrison_Gettelman/m_micro_post.meta index 684ac3f21..88a4325e7 100644 --- a/physics/m_micro_post.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = m_micro_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro_pre.F90 b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 similarity index 100% rename from physics/m_micro_pre.F90 rename to physics/MP/Morrison_Gettelman/m_micro_pre.F90 diff --git a/physics/m_micro_pre.meta b/physics/MP/Morrison_Gettelman/m_micro_pre.meta similarity index 99% rename from physics/m_micro_pre.meta rename to physics/MP/Morrison_Gettelman/m_micro_pre.meta index 7ac592833..b8cd2ac32 100644 --- a/physics/m_micro_pre.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/micro_mg2_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg2_0.F90 similarity index 100% rename from physics/micro_mg2_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg2_0.F90 diff --git a/physics/micro_mg3_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 similarity index 100% rename from physics/micro_mg3_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg3_0.F90 diff --git a/physics/micro_mg_utils.F90 b/physics/MP/Morrison_Gettelman/micro_mg_utils.F90 similarity index 100% rename from physics/micro_mg_utils.F90 rename to physics/MP/Morrison_Gettelman/micro_mg_utils.F90 diff --git a/physics/wv_saturation.F b/physics/MP/Morrison_Gettelman/wv_saturation.F similarity index 100% rename from physics/wv_saturation.F rename to physics/MP/Morrison_Gettelman/wv_saturation.F diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/MP/NSSL/module_mp_nssl_2mom.F90 similarity index 100% rename from physics/module_mp_nssl_2mom.F90 rename to physics/MP/NSSL/module_mp_nssl_2mom.F90 diff --git a/physics/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 similarity index 100% rename from physics/mp_nssl.F90 rename to physics/MP/NSSL/mp_nssl.F90 diff --git a/physics/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta similarity index 99% rename from physics/mp_nssl.meta rename to physics/MP/NSSL/mp_nssl.meta index 6bbf92c73..ff7c82223 100644 --- a/physics/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_nssl type = scheme - dependencies = machine.F,module_mp_nssl_2mom.F90 + dependencies = ../../hooks/machine.F,module_mp_nssl_2mom.F90 [ccpp-arg-table] name = mp_nssl_init diff --git a/physics/module_mp_radar.F90 b/physics/MP/Thompson/module_mp_radar.F90 similarity index 100% rename from physics/module_mp_radar.F90 rename to physics/MP/Thompson/module_mp_radar.F90 diff --git a/physics/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 similarity index 100% rename from physics/module_mp_thompson.F90 rename to physics/MP/Thompson/module_mp_thompson.F90 diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 similarity index 100% rename from physics/module_mp_thompson_make_number_concentrations.F90 rename to physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 diff --git a/physics/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 similarity index 100% rename from physics/mp_thompson.F90 rename to physics/MP/Thompson/mp_thompson.F90 diff --git a/physics/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta similarity index 99% rename from physics/mp_thompson.meta rename to physics/MP/Thompson/mp_thompson.meta index 691698281..c3795e10e 100644 --- a/physics/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson type = scheme - dependencies = machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = ../../hooks/machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 similarity index 100% rename from physics/mp_thompson_post.F90 rename to physics/MP/Thompson/mp_thompson_post.F90 diff --git a/physics/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta similarity index 98% rename from physics/mp_thompson_post.meta rename to physics/MP/Thompson/mp_thompson_post.meta index 82b035e99..43e89b29c 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/MP/Thompson/mp_thompson_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_pre.F90 b/physics/MP/Thompson/mp_thompson_pre.F90 similarity index 100% rename from physics/mp_thompson_pre.F90 rename to physics/MP/Thompson/mp_thompson_pre.F90 diff --git a/physics/mp_thompson_pre.meta b/physics/MP/Thompson/mp_thompson_pre.meta similarity index 97% rename from physics/mp_thompson_pre.meta rename to physics/MP/Thompson/mp_thompson_pre.meta index 12e812bb3..563eb2809 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/MP/Thompson/mp_thompson_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/zhaocarr_gscond.f b/physics/MP/Zhao_Carr/zhaocarr_gscond.f similarity index 100% rename from physics/zhaocarr_gscond.f rename to physics/MP/Zhao_Carr/zhaocarr_gscond.f diff --git a/physics/zhaocarr_gscond.meta b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta similarity index 98% rename from physics/zhaocarr_gscond.meta rename to physics/MP/Zhao_Carr/zhaocarr_gscond.meta index 493397722..ed57ca909 100644 --- a/physics/zhaocarr_gscond.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_gscond type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/zhaocarr_precpd.f b/physics/MP/Zhao_Carr/zhaocarr_precpd.f similarity index 100% rename from physics/zhaocarr_precpd.f rename to physics/MP/Zhao_Carr/zhaocarr_precpd.f diff --git a/physics/zhaocarr_precpd.meta b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta similarity index 98% rename from physics/zhaocarr_precpd.meta rename to physics/MP/Zhao_Carr/zhaocarr_precpd.meta index 67f1a530b..86e6c7d67 100644 --- a/physics/zhaocarr_precpd.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_precpd type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/calpreciptype.f90 b/physics/MP/calpreciptype.f90 similarity index 100% rename from physics/calpreciptype.f90 rename to physics/MP/calpreciptype.f90 diff --git a/physics/gfs_phy_tracer_config.F b/physics/NOTUSED/gfs_phy_tracer_config.F similarity index 100% rename from physics/gfs_phy_tracer_config.F rename to physics/NOTUSED/gfs_phy_tracer_config.F diff --git a/physics/gocart_tracer_config_stub.f b/physics/NOTUSED/gocart_tracer_config_stub.f similarity index 100% rename from physics/gocart_tracer_config_stub.f rename to physics/NOTUSED/gocart_tracer_config_stub.f diff --git a/physics/rrtmg_lw_pre.F90 b/physics/NOTUSED/rrtmg_lw_pre.F90 similarity index 100% rename from physics/rrtmg_lw_pre.F90 rename to physics/NOTUSED/rrtmg_lw_pre.F90 diff --git a/physics/rrtmg_lw_pre.meta b/physics/NOTUSED/rrtmg_lw_pre.meta similarity index 100% rename from physics/rrtmg_lw_pre.meta rename to physics/NOTUSED/rrtmg_lw_pre.meta diff --git a/physics/hedmf.f b/physics/PBL/HEDMF/hedmf.f similarity index 100% rename from physics/hedmf.f rename to physics/PBL/HEDMF/hedmf.f diff --git a/physics/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta similarity index 99% rename from physics/hedmf.meta rename to physics/PBL/HEDMF/hedmf.meta index c2d873065..be0c83741 100644 --- a/physics/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = hedmf type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/module_BL_MYJPBL.F90 b/physics/PBL/MYJ/module_BL_MYJPBL.F90 similarity index 100% rename from physics/module_BL_MYJPBL.F90 rename to physics/PBL/MYJ/module_BL_MYJPBL.F90 diff --git a/physics/myjpbl_wrapper.F90 b/physics/PBL/MYJ/myjpbl_wrapper.F90 similarity index 100% rename from physics/myjpbl_wrapper.F90 rename to physics/PBL/MYJ/myjpbl_wrapper.F90 diff --git a/physics/myjpbl_wrapper.meta b/physics/PBL/MYJ/myjpbl_wrapper.meta similarity index 99% rename from physics/myjpbl_wrapper.meta rename to physics/PBL/MYJ/myjpbl_wrapper.meta index 427088b86..281396eed 100644 --- a/physics/myjpbl_wrapper.meta +++ b/physics/PBL/MYJ/myjpbl_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjpbl_wrapper type = scheme - dependencies = module_BL_MYJPBL.F90 + dependencies = ../../hooks/machine.F,module_BL_MYJPBL.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/bl_mynn_common.f90 b/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 similarity index 100% rename from physics/bl_mynn_common.f90 rename to physics/PBL/MYNN_EDMF/bl_mynn_common.f90 diff --git a/physics/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 similarity index 100% rename from physics/module_bl_mynn.F90 rename to physics/PBL/MYNN_EDMF/module_bl_mynn.F90 diff --git a/physics/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 similarity index 100% rename from physics/mynnedmf_wrapper.F90 rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 diff --git a/physics/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta similarity index 99% rename from physics/mynnedmf_wrapper.meta rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index ec4706aba..8e88d9620 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnedmf_wrapper type = scheme - dependencies = machine.F,module_bl_mynn.F90,physcons.F90,bl_mynn_common.f90 + dependencies = ../../hooks/machine.F,module_bl_mynn.F90,bl_mynn_common.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mfscu.f b/physics/PBL/SATMEDMF/mfscu.f similarity index 100% rename from physics/mfscu.f rename to physics/PBL/SATMEDMF/mfscu.f diff --git a/physics/mfscuq.f b/physics/PBL/SATMEDMF/mfscuq.f similarity index 100% rename from physics/mfscuq.f rename to physics/PBL/SATMEDMF/mfscuq.f diff --git a/physics/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F similarity index 100% rename from physics/satmedmfvdif.F rename to physics/PBL/SATMEDMF/satmedmfvdif.F diff --git a/physics/satmedmfvdif.meta b/physics/PBL/SATMEDMF/satmedmfvdif.meta similarity index 99% rename from physics/satmedmfvdif.meta rename to physics/PBL/SATMEDMF/satmedmfvdif.meta index 3609ed50f..b94e74d6c 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdif type = scheme - dependencies = funcphys.f90,machine.F,mfpblt.f,mfscu.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpblt.f,mfscu.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F similarity index 100% rename from physics/satmedmfvdifq.F rename to physics/PBL/SATMEDMF/satmedmfvdifq.F diff --git a/physics/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta similarity index 99% rename from physics/satmedmfvdifq.meta rename to physics/PBL/SATMEDMF/satmedmfvdifq.meta index b6680dccb..ff718f138 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdifq type = scheme - dependencies = funcphys.f90,machine.F,mfpbltq.f,mfscuq.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbltq.f,mfscuq.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/moninshoc.f b/physics/PBL/SHOC/moninshoc.f similarity index 100% rename from physics/moninshoc.f rename to physics/PBL/SHOC/moninshoc.f diff --git a/physics/moninshoc.meta b/physics/PBL/SHOC/moninshoc.meta similarity index 99% rename from physics/moninshoc.meta rename to physics/PBL/SHOC/moninshoc.meta index dca5736f5..474689ea0 100644 --- a/physics/moninshoc.meta +++ b/physics/PBL/SHOC/moninshoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = moninshoc type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/shoc.F90 b/physics/PBL/SHOC/shoc.F90 similarity index 100% rename from physics/shoc.F90 rename to physics/PBL/SHOC/shoc.F90 diff --git a/physics/shoc.meta b/physics/PBL/SHOC/shoc.meta similarity index 99% rename from physics/shoc.meta rename to physics/PBL/SHOC/shoc.meta index 984c6aec5..a1550ce11 100644 --- a/physics/shoc.meta +++ b/physics/PBL/SHOC/shoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shoc type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ysuvdif.F90 b/physics/PBL/YSU/ysuvdif.F90 similarity index 100% rename from physics/ysuvdif.F90 rename to physics/PBL/YSU/ysuvdif.F90 diff --git a/physics/ysuvdif.meta b/physics/PBL/YSU/ysuvdif.meta similarity index 99% rename from physics/ysuvdif.meta rename to physics/PBL/YSU/ysuvdif.meta index 0007197bd..20e96a92d 100644 --- a/physics/ysuvdif.meta +++ b/physics/PBL/YSU/ysuvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ysuvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/mfpbl.f b/physics/PBL/mfpbl.f similarity index 100% rename from physics/mfpbl.f rename to physics/PBL/mfpbl.f diff --git a/physics/mfpblt.f b/physics/PBL/mfpblt.f similarity index 100% rename from physics/mfpblt.f rename to physics/PBL/mfpblt.f diff --git a/physics/mfpbltq.f b/physics/PBL/mfpbltq.f similarity index 100% rename from physics/mfpbltq.f rename to physics/PBL/mfpbltq.f diff --git a/physics/shinhongvdif.F90 b/physics/PBL/saYSU/shinhongvdif.F90 similarity index 100% rename from physics/shinhongvdif.F90 rename to physics/PBL/saYSU/shinhongvdif.F90 diff --git a/physics/shinhongvdif.meta b/physics/PBL/saYSU/shinhongvdif.meta similarity index 99% rename from physics/shinhongvdif.meta rename to physics/PBL/saYSU/shinhongvdif.meta index dcd3b96cd..8b1d48605 100644 --- a/physics/shinhongvdif.meta +++ b/physics/PBL/saYSU/shinhongvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shinhongvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/tridi.f b/physics/PBL/tridi.f similarity index 100% rename from physics/tridi.f rename to physics/PBL/tridi.f diff --git a/physics/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f similarity index 100% rename from physics/iounitdef.f rename to physics/Radiation/RRTMG/iounitdef.f diff --git a/physics/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f similarity index 100% rename from physics/module_bfmicrophysics.f rename to physics/Radiation/RRTMG/module_bfmicrophysics.f diff --git a/physics/rad_sw_pre.F90 b/physics/Radiation/RRTMG/rad_sw_pre.F90 similarity index 100% rename from physics/rad_sw_pre.F90 rename to physics/Radiation/RRTMG/rad_sw_pre.F90 diff --git a/physics/rad_sw_pre.meta b/physics/Radiation/RRTMG/rad_sw_pre.meta similarity index 96% rename from physics/rad_sw_pre.meta rename to physics/Radiation/RRTMG/rad_sw_pre.meta index ccbdbf74b..9d14c6ffc 100644 --- a/physics/rad_sw_pre.meta +++ b/physics/Radiation/RRTMG/rad_sw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rad_sw_pre type = scheme - dependencies = iounitdef.f,machine.F + dependencies = iounitdef.f,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/radcons.f90 b/physics/Radiation/RRTMG/radcons.f90 similarity index 100% rename from physics/radcons.f90 rename to physics/Radiation/RRTMG/radcons.f90 diff --git a/physics/radlw_datatb.f b/physics/Radiation/RRTMG/radlw_datatb.f similarity index 100% rename from physics/radlw_datatb.f rename to physics/Radiation/RRTMG/radlw_datatb.f diff --git a/physics/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 similarity index 100% rename from physics/radlw_main.F90 rename to physics/Radiation/RRTMG/radlw_main.F90 diff --git a/physics/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta similarity index 99% rename from physics/radlw_main.meta rename to physics/Radiation/RRTMG/radlw_main.meta index 3dccc97b3..f7c80fb20 100644 --- a/physics/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radlw_datatb.f,radlw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radlw_datatb.f,radlw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/radlw_param.f b/physics/Radiation/RRTMG/radlw_param.f similarity index 100% rename from physics/radlw_param.f rename to physics/Radiation/RRTMG/radlw_param.f diff --git a/physics/radlw_param.meta b/physics/Radiation/RRTMG/radlw_param.meta similarity index 100% rename from physics/radlw_param.meta rename to physics/Radiation/RRTMG/radlw_param.meta diff --git a/physics/radsw_datatb.f b/physics/Radiation/RRTMG/radsw_datatb.f similarity index 100% rename from physics/radsw_datatb.f rename to physics/Radiation/RRTMG/radsw_datatb.f diff --git a/physics/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 similarity index 100% rename from physics/radsw_main.F90 rename to physics/Radiation/RRTMG/radsw_main.F90 diff --git a/physics/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta similarity index 99% rename from physics/radsw_main.meta rename to physics/Radiation/RRTMG/radsw_main.meta index 1edb6fcac..2169a26f0 100644 --- a/physics/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radsw_datatb.f,radsw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radsw_datatb.f,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/radsw_param.f b/physics/Radiation/RRTMG/radsw_param.f similarity index 100% rename from physics/radsw_param.f rename to physics/Radiation/RRTMG/radsw_param.f diff --git a/physics/radsw_param.meta b/physics/Radiation/RRTMG/radsw_param.meta similarity index 100% rename from physics/radsw_param.meta rename to physics/Radiation/RRTMG/radsw_param.meta diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_lw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 diff --git a/physics/rrtmg_lw_post.F90 b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 similarity index 100% rename from physics/rrtmg_lw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_post.F90 diff --git a/physics/rrtmg_lw_post.meta b/physics/Radiation/RRTMG/rrtmg_lw_post.meta similarity index 99% rename from physics/rrtmg_lw_post.meta rename to physics/Radiation/RRTMG/rrtmg_lw_post.meta index 7f219c24f..6ed7c2365 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_lw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_sw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 diff --git a/physics/rrtmg_sw_post.F90 b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 similarity index 100% rename from physics/rrtmg_sw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_post.F90 diff --git a/physics/rrtmg_sw_post.meta b/physics/Radiation/RRTMG/rrtmg_sw_post.meta similarity index 99% rename from physics/rrtmg_sw_post.meta rename to physics/Radiation/RRTMG/rrtmg_sw_post.meta index 6a9f4efb5..9914051ce 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_sw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw_post type = scheme - dependencies = machine.F,radsw_param.f + dependencies = ../../hooks/machine.F,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_aerosol_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 similarity index 100% rename from physics/rrtmgp_aerosol_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta similarity index 98% rename from physics/rrtmgp_aerosol_optics.meta rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta index cc9eb1cc2..0847877d6 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_aerosol_optics type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 + dependencies = ../iounitdef.f,../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 similarity index 100% rename from physics/rrtmgp_lw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 similarity index 100% rename from physics/rrtmgp_lw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 diff --git a/physics/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 similarity index 100% rename from physics/rrtmgp_lw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 diff --git a/physics/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta similarity index 98% rename from physics/rrtmgp_lw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index fd96eb14b..011376985 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90 + dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../GFS/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sampling.F90 b/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 similarity index 100% rename from physics/rrtmgp_sampling.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sampling.F90 diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 similarity index 100% rename from physics/rrtmgp_sw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 similarity index 100% rename from physics/rrtmgp_sw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 diff --git a/physics/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 similarity index 100% rename from physics/rrtmgp_sw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 diff --git a/physics/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta similarity index 98% rename from physics/rrtmgp_sw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index dbb93a5df..932e2195e 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_sw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90 + dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../GFS/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mersenne_twister.f b/physics/Radiation/mersenne_twister.f similarity index 100% rename from physics/mersenne_twister.f rename to physics/Radiation/mersenne_twister.f diff --git a/physics/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f similarity index 100% rename from physics/radiation_aerosols.f rename to physics/Radiation/radiation_aerosols.f diff --git a/physics/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f similarity index 100% rename from physics/radiation_astronomy.f rename to physics/Radiation/radiation_astronomy.f diff --git a/physics/radiation_cloud_overlap.F90 b/physics/Radiation/radiation_cloud_overlap.F90 similarity index 100% rename from physics/radiation_cloud_overlap.F90 rename to physics/Radiation/radiation_cloud_overlap.F90 diff --git a/physics/radiation_clouds.f b/physics/Radiation/radiation_clouds.f similarity index 100% rename from physics/radiation_clouds.f rename to physics/Radiation/radiation_clouds.f diff --git a/physics/radiation_gases.f b/physics/Radiation/radiation_gases.f similarity index 100% rename from physics/radiation_gases.f rename to physics/Radiation/radiation_gases.f diff --git a/physics/radiation_surface.f b/physics/Radiation/radiation_surface.f similarity index 100% rename from physics/radiation_surface.f rename to physics/Radiation/radiation_surface.f diff --git a/physics/radiation_tools.F90 b/physics/Radiation/radiation_tools.F90 similarity index 100% rename from physics/radiation_tools.F90 rename to physics/Radiation/radiation_tools.F90 diff --git a/physics/date_def.f b/physics/SFC_Layer/GFS_sfc/date_def.f similarity index 100% rename from physics/date_def.f rename to physics/SFC_Layer/GFS_sfc/date_def.f diff --git a/physics/module_nst_model.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_model.f90 similarity index 100% rename from physics/module_nst_model.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_model.f90 diff --git a/physics/module_nst_parameters.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 similarity index 100% rename from physics/module_nst_parameters.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 diff --git a/physics/module_nst_water_prop.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 similarity index 100% rename from physics/module_nst_water_prop.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 diff --git a/physics/sfc_cice.f b/physics/SFC_Layer/GFS_sfc/sfc_cice.f similarity index 100% rename from physics/sfc_cice.f rename to physics/SFC_Layer/GFS_sfc/sfc_cice.f diff --git a/physics/sfc_cice.meta b/physics/SFC_Layer/GFS_sfc/sfc_cice.meta similarity index 99% rename from physics/sfc_cice.meta rename to physics/SFC_Layer/GFS_sfc/sfc_cice.meta index 796fb2f5d..52fa28a3d 100644 --- a/physics/sfc_cice.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_cice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_cice type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag.f b/physics/SFC_Layer/GFS_sfc/sfc_diag.f similarity index 100% rename from physics/sfc_diag.f rename to physics/SFC_Layer/GFS_sfc/sfc_diag.f diff --git a/physics/sfc_diag.meta b/physics/SFC_Layer/GFS_sfc/sfc_diag.meta similarity index 99% rename from physics/sfc_diag.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diag.meta index a16290b58..6a82c2c61 100644 --- a/physics/sfc_diag.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diag.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag_post.F90 b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 similarity index 100% rename from physics/sfc_diag_post.F90 rename to physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 diff --git a/physics/sfc_diag_post.meta b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta similarity index 98% rename from physics/sfc_diag_post.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta index c50d3c4dc..8c74e2154 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag_post type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diff.f b/physics/SFC_Layer/GFS_sfc/sfc_diff.f similarity index 100% rename from physics/sfc_diff.f rename to physics/SFC_Layer/GFS_sfc/sfc_diff.f diff --git a/physics/sfc_diff.meta b/physics/SFC_Layer/GFS_sfc/sfc_diff.meta similarity index 99% rename from physics/sfc_diff.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diff.meta index eb30b8c50..b9f0c4f84 100644 --- a/physics/sfc_diff.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diff.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diff type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst.f b/physics/SFC_Layer/GFS_sfc/sfc_nst.f similarity index 100% rename from physics/sfc_nst.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst.f diff --git a/physics/sfc_nst.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst.meta similarity index 99% rename from physics/sfc_nst.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst.meta index dc35ec959..131daaab0 100644 --- a/physics/sfc_nst.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_nst type = scheme - dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = date_def.f,../../tools/funcphys.f90,../../hooks/machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst_post.f b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.f similarity index 100% rename from physics/sfc_nst_post.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst_post.f diff --git a/physics/sfc_nst_post.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta similarity index 98% rename from physics/sfc_nst_post.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta index 7f66118e9..caa487384 100644 --- a/physics/sfc_nst_post.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_post type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst_pre.f b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f similarity index 100% rename from physics/sfc_nst_pre.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f diff --git a/physics/sfc_nst_pre.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta similarity index 97% rename from physics/sfc_nst_pre.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta index 88788ff5c..e9cdef0d1 100644 --- a/physics/sfc_nst_pre.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_pre type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_ocean.F b/physics/SFC_Layer/GFS_sfc/sfc_ocean.F similarity index 100% rename from physics/sfc_ocean.F rename to physics/SFC_Layer/GFS_sfc/sfc_ocean.F diff --git a/physics/sfc_ocean.meta b/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta similarity index 99% rename from physics/sfc_ocean.meta rename to physics/SFC_Layer/GFS_sfc/sfc_ocean.meta index 15812e723..ea575a071 100644 --- a/physics/sfc_ocean.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_ocean type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_sice.f b/physics/SFC_Layer/GFS_sfc/sfc_sice.f similarity index 100% rename from physics/sfc_sice.f rename to physics/SFC_Layer/GFS_sfc/sfc_sice.f diff --git a/physics/sfc_sice.meta b/physics/SFC_Layer/GFS_sfc/sfc_sice.meta similarity index 99% rename from physics/sfc_sice.meta rename to physics/SFC_Layer/GFS_sfc/sfc_sice.meta index 75aab21a4..7277c0511 100644 --- a/physics/sfc_sice.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_sice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_sice type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/module_SF_JSFC.F90 b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 similarity index 100% rename from physics/module_SF_JSFC.F90 rename to physics/SFC_Layer/MYJ/module_SF_JSFC.F90 diff --git a/physics/myjsfc_wrapper.F90 b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 similarity index 100% rename from physics/myjsfc_wrapper.F90 rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 diff --git a/physics/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta similarity index 99% rename from physics/myjsfc_wrapper.meta rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 40b6b78f3..9805db619 100644 --- a/physics/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjsfc_wrapper type = scheme - dependencies = module_SF_JSFC.F90 + dependencies = ../../hooks/machine.f,module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_mynn.F90 b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 similarity index 100% rename from physics/module_sf_mynn.F90 rename to physics/SFC_Layer/MYNN/module_sf_mynn.F90 diff --git a/physics/mynnsfc_wrapper.F90 b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 similarity index 100% rename from physics/mynnsfc_wrapper.F90 rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 diff --git a/physics/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta similarity index 99% rename from physics/mynnsfc_wrapper.meta rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index d89cc5d35..a76df3790 100644 --- a/physics/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnsfc_wrapper type = scheme - dependencies = machine.F,module_sf_mynn.F90 + dependencies = ../../hooks/machine.F,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/h2o_def.f b/physics/h2o_photo/h2o_def.f similarity index 100% rename from physics/h2o_def.f rename to physics/h2o_photo/h2o_def.f diff --git a/physics/h2o_def.meta b/physics/h2o_photo/h2o_def.meta similarity index 94% rename from physics/h2o_def.meta rename to physics/h2o_photo/h2o_def.meta index 17f0f8779..3bb9bf94d 100644 --- a/physics/h2o_def.meta +++ b/physics/h2o_photo/h2o_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2o_def type = module - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = h2o_def diff --git a/physics/h2ointerp.f90 b/physics/h2o_photo/h2ointerp.f90 similarity index 100% rename from physics/h2ointerp.f90 rename to physics/h2o_photo/h2ointerp.f90 diff --git a/physics/h2ophys.f b/physics/h2o_photo/h2ophys.f similarity index 100% rename from physics/h2ophys.f rename to physics/h2o_photo/h2ophys.f diff --git a/physics/h2ophys.meta b/physics/h2o_photo/h2ophys.meta similarity index 98% rename from physics/h2ophys.meta rename to physics/h2o_photo/h2ophys.meta index afe50bda1..d8a9eabab 100644 --- a/physics/h2ophys.meta +++ b/physics/h2o_photo/h2ophys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2ophys type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/machine.F b/physics/hooks/machine.F similarity index 100% rename from physics/machine.F rename to physics/hooks/machine.F diff --git a/physics/machine.meta b/physics/hooks/machine.meta similarity index 100% rename from physics/machine.meta rename to physics/hooks/machine.meta diff --git a/physics/physcons.F90 b/physics/hooks/physcons.F90 similarity index 100% rename from physics/physcons.F90 rename to physics/hooks/physcons.F90 diff --git a/physics/ozinterp.f90 b/physics/o3_photo/ozinterp.f90 similarity index 100% rename from physics/ozinterp.f90 rename to physics/o3_photo/ozinterp.f90 diff --git a/physics/ozne_def.f b/physics/o3_photo/ozne_def.f similarity index 100% rename from physics/ozne_def.f rename to physics/o3_photo/ozne_def.f diff --git a/physics/ozne_def.meta b/physics/o3_photo/ozne_def.meta similarity index 95% rename from physics/ozne_def.meta rename to physics/o3_photo/ozne_def.meta index 3cad9c14d..3123892bb 100644 --- a/physics/ozne_def.meta +++ b/physics/o3_photo/ozne_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozne_def type = module - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = ozne_def diff --git a/physics/ozphys.f b/physics/o3_photo/ozphys.f similarity index 100% rename from physics/ozphys.f rename to physics/o3_photo/ozphys.f diff --git a/physics/ozphys.meta b/physics/o3_photo/ozphys.meta similarity index 99% rename from physics/ozphys.meta rename to physics/o3_photo/ozphys.meta index 485e2a491..631dcb332 100644 --- a/physics/ozphys.meta +++ b/physics/o3_photo/ozphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ozphys_2015.f b/physics/o3_photo/ozphys_2015.f similarity index 100% rename from physics/ozphys_2015.f rename to physics/o3_photo/ozphys_2015.f diff --git a/physics/ozphys_2015.meta b/physics/o3_photo/ozphys_2015.meta similarity index 99% rename from physics/ozphys_2015.meta rename to physics/o3_photo/ozphys_2015.meta index 8bce7defe..7da8cdf27 100644 --- a/physics/ozphys_2015.meta +++ b/physics/o3_photo/ozphys_2015.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys_2015 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp deleted file mode 160000 index 0dc54f5ec..000000000 --- a/physics/rte-rrtmgp +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 0dc54f5ecaeb1e1e342efd1e02d0bcd41737bde2 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50f7afae7..339f6ca03 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90 + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index bf2fddd60..5bf86c6bd 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/funcphys.f90 b/physics/tools/funcphys.f90 similarity index 100% rename from physics/funcphys.f90 rename to physics/tools/funcphys.f90 diff --git a/physics/get_phi_fv3.F90 b/physics/tools/get_phi_fv3.F90 similarity index 100% rename from physics/get_phi_fv3.F90 rename to physics/tools/get_phi_fv3.F90 diff --git a/physics/get_phi_fv3.meta b/physics/tools/get_phi_fv3.meta similarity index 97% rename from physics/get_phi_fv3.meta rename to physics/tools/get_phi_fv3.meta index cbca14080..5c162c746 100644 --- a/physics/get_phi_fv3.meta +++ b/physics/tools/get_phi_fv3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = get_phi_fv3 type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../hooks/machine.F,../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/get_prs_fv3.F90 b/physics/tools/get_prs_fv3.F90 similarity index 100% rename from physics/get_prs_fv3.F90 rename to physics/tools/get_prs_fv3.F90 diff --git a/physics/get_prs_fv3.meta b/physics/tools/get_prs_fv3.meta similarity index 98% rename from physics/get_prs_fv3.meta rename to physics/tools/get_prs_fv3.meta index c26f5c308..4cdad7566 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/tools/get_prs_fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = get_prs_fv3 type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] From 53eda4d0e2af5d8ded2182b08fd9fbafa1b55114 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 5 Sep 2023 15:11:58 +0000 Subject: [PATCH 034/122] Address comments from review. --- physics/CONV/{CCC => C3}/cu_c3_deep.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver.meta | 0 physics/CONV/{CCC => C3}/cu_c3_driver_post.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver_post.meta | 0 physics/CONV/{CCC => C3}/cu_c3_driver_pre.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver_pre.meta | 0 physics/CONV/{CCC => C3}/cu_c3_sh.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_common.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.meta | 2 +- .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.meta | 2 +- .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.meta | 2 +- .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.meta | 2 +- .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.meta | 0 .../GFS_suite_interstitial_phys_reset.F90 | 0 .../GFS_suite_interstitial_phys_reset.meta | 0 .../GFS_suite_interstitial_rad_reset.F90 | 0 .../GFS_suite_interstitial_rad_reset.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.meta | 0 .../GFS_surface_loop_control_part1.F90 | 0 .../GFS_surface_loop_control_part1.meta | 0 .../GFS_surface_loop_control_part2.F90 | 0 .../GFS_surface_loop_control_part2.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/aerinterp.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.f | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.f | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/gcycle.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccn_def.F | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccninterp.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sfcsub.F | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.meta | 0 physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.F90 | 0 physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.meta | 3 ++- physics/SFC_Layer/{GFS_sfc => UFS}/date_def.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_model.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_parameters.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_water_prop.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.F90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.meta | 0 physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.f90 | 0 physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.meta | 0 physics/{Land => SFC_Models/Lake}/Flake/flake.F90 | 0 physics/{Land => SFC_Models/Lake}/Flake/flake_driver.F90 | 0 physics/{Land => SFC_Models/Lake}/Flake/flake_driver.meta | 0 physics/{ => SFC_Models}/Land/Noah/lsm_noah.f | 0 physics/{ => SFC_Models}/Land/Noah/lsm_noah.meta | 0 physics/{ => SFC_Models}/Land/Noah/sflx.f | 0 physics/{ => SFC_Models}/Land/Noah/surface_perturbation.F90 | 0 .../{ => SFC_Models}/Land/Noahmp/module_sf_noahmp_glacier.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmplsm.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmp_tables.f90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.meta | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmptable.tbl | 0 physics/{ => SFC_Models}/Land/RUC/lsm_ruc.F90 | 0 physics/{ => SFC_Models}/Land/RUC/lsm_ruc.meta | 0 physics/{ => SFC_Models}/Land/RUC/module_sf_ruclsm.F90 | 0 physics/{ => SFC_Models}/Land/RUC/module_soil_pre.F90 | 0 physics/{ => SFC_Models}/Land/RUC/namelist_soilveg_ruc.F90 | 0 physics/{ => SFC_Models}/Land/RUC/set_soilveg_ruc.F90 | 0 physics/{ => SFC_Models}/Land/namelist_soilveg.f | 0 physics/{ => SFC_Models}/Land/set_soilveg.f | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.F | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.meta | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.f | 0 .../GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.meta | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.f | 0 .../GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.meta | 0 163 files changed, 6 insertions(+), 5 deletions(-) rename physics/CONV/{CCC => C3}/cu_c3_deep.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_post.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_post.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_pre.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_pre.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_sh.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_common.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_phys_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_phys_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_rad_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_rad_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part1.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part1.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part2.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part2.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/aerinterp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.f (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.f (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/gcycle.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccn_def.F (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccninterp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sfcsub.F (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.meta (100%) rename physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.F90 (100%) rename physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.meta (99%) rename physics/SFC_Layer/{GFS_sfc => UFS}/date_def.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_model.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_parameters.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_water_prop.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.F90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.meta (100%) rename physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.f90 (100%) rename physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.meta (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake.F90 (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake_driver.F90 (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake_driver.meta (100%) rename physics/{ => SFC_Models}/Land/Noah/lsm_noah.f (100%) rename physics/{ => SFC_Models}/Land/Noah/lsm_noah.meta (100%) rename physics/{ => SFC_Models}/Land/Noah/sflx.f (100%) rename physics/{ => SFC_Models}/Land/Noah/surface_perturbation.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmp_glacier.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmplsm.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmp_tables.f90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.meta (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmptable.tbl (100%) rename physics/{ => SFC_Models}/Land/RUC/lsm_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/lsm_ruc.meta (100%) rename physics/{ => SFC_Models}/Land/RUC/module_sf_ruclsm.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/module_soil_pre.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/namelist_soilveg_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/set_soilveg_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/namelist_soilveg.f (100%) rename physics/{ => SFC_Models}/Land/set_soilveg.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.F (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.meta (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.meta (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.meta (100%) diff --git a/physics/CONV/CCC/cu_c3_deep.F90 b/physics/CONV/C3/cu_c3_deep.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_deep.F90 rename to physics/CONV/C3/cu_c3_deep.F90 diff --git a/physics/CONV/CCC/cu_c3_driver.F90 b/physics/CONV/C3/cu_c3_driver.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver.F90 rename to physics/CONV/C3/cu_c3_driver.F90 diff --git a/physics/CONV/CCC/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver.meta rename to physics/CONV/C3/cu_c3_driver.meta diff --git a/physics/CONV/CCC/cu_c3_driver_post.F90 b/physics/CONV/C3/cu_c3_driver_post.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_post.F90 rename to physics/CONV/C3/cu_c3_driver_post.F90 diff --git a/physics/CONV/CCC/cu_c3_driver_post.meta b/physics/CONV/C3/cu_c3_driver_post.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_post.meta rename to physics/CONV/C3/cu_c3_driver_post.meta diff --git a/physics/CONV/CCC/cu_c3_driver_pre.F90 b/physics/CONV/C3/cu_c3_driver_pre.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_pre.F90 rename to physics/CONV/C3/cu_c3_driver_pre.F90 diff --git a/physics/CONV/CCC/cu_c3_driver_pre.meta b/physics/CONV/C3/cu_c3_driver_pre.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_pre.meta rename to physics/CONV/C3/cu_c3_driver_pre.meta diff --git a/physics/CONV/CCC/cu_c3_sh.F90 b/physics/CONV/C3/cu_c3_sh.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_sh.F90 rename to physics/CONV/C3/cu_c3_sh.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_MP_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_MP_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_common.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_common.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 diff --git a/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_cloud_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta diff --git a/physics/Interstitials/GFS/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_debug.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 diff --git a/physics/Interstitials/GFS/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_debug.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 45125385c..2aec034fd 100644 --- a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 84f22aede..d033c889b 100644 --- a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta diff --git a/physics/Interstitials/GFS/GFS_radiation_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_radiation_surface.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 diff --git a/physics/Interstitials/GFS/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_radiation_surface.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index c18b81d9f..79837d0bf 100644 --- a/physics/Interstitials/GFS/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f - dependencies = Land/RUC/set_soilveg_ruc.F90,Land/RUC/namelist_soilveg_ruc.F90 + dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 dependencies = hooks/machine.F ######################################################################## diff --git a/physics/Interstitials/GFS/GFS_rrtmg_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_rrtmg_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index e0e67c8f5..af95daf52 100644 --- a/physics/Interstitials/GFS/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -7,7 +7,7 @@ dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 - dependencies = Land/Noah/surface_perturbation.F90 + dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/GFS/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta diff --git a/physics/Interstitials/GFS/GFS_stochastics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_stochastics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 diff --git a/physics/Interstitials/GFS/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_stochastics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_4.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_5.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_update.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_update.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_inter.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_inter.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_inter.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_inter.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta diff --git a/physics/Interstitials/GFS/GFS_surface_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta diff --git a/physics/Interstitials/GFS/aerinterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 similarity index 100% rename from physics/Interstitials/GFS/aerinterp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 diff --git a/physics/Interstitials/GFS/cnvc90.f b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f similarity index 100% rename from physics/Interstitials/GFS/cnvc90.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f diff --git a/physics/Interstitials/GFS/cnvc90.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta similarity index 100% rename from physics/Interstitials/GFS/cnvc90.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta diff --git a/physics/Interstitials/GFS/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f similarity index 100% rename from physics/Interstitials/GFS/dcyc2t3.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f diff --git a/physics/Interstitials/GFS/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta similarity index 100% rename from physics/Interstitials/GFS/dcyc2t3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta diff --git a/physics/Interstitials/GFS/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 similarity index 100% rename from physics/Interstitials/GFS/gcycle.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 diff --git a/physics/Interstitials/GFS/iccn_def.F b/physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F similarity index 100% rename from physics/Interstitials/GFS/iccn_def.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F diff --git a/physics/Interstitials/GFS/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 similarity index 100% rename from physics/Interstitials/GFS/iccninterp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 diff --git a/physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 similarity index 100% rename from physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 diff --git a/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta similarity index 100% rename from physics/Interstitials/GFS/maximum_hourly_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta diff --git a/physics/Interstitials/GFS/phys_tend.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.F90 similarity index 100% rename from physics/Interstitials/GFS/phys_tend.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.F90 diff --git a/physics/Interstitials/GFS/phys_tend.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.meta similarity index 100% rename from physics/Interstitials/GFS/phys_tend.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.meta diff --git a/physics/Interstitials/GFS/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 similarity index 100% rename from physics/Interstitials/GFS/scm_sfc_flux_spec.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 diff --git a/physics/Interstitials/GFS/scm_sfc_flux_spec.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta similarity index 100% rename from physics/Interstitials/GFS/scm_sfc_flux_spec.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta diff --git a/physics/Interstitials/GFS/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F similarity index 100% rename from physics/Interstitials/GFS/sfcsub.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F diff --git a/physics/Interstitials/GFS/sgscloud_radpost.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpost.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 diff --git a/physics/Interstitials/GFS/sgscloud_radpost.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpost.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta diff --git a/physics/Interstitials/GFS/sgscloud_radpre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 diff --git a/physics/Interstitials/GFS/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta diff --git a/physics/MP/GFDL/gfdl_sfc_layer.F90 b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 similarity index 100% rename from physics/MP/GFDL/gfdl_sfc_layer.F90 rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 diff --git a/physics/MP/GFDL/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta similarity index 99% rename from physics/MP/GFDL/gfdl_sfc_layer.meta rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index a64fe277c..b0d613eed 100644 --- a/physics/MP/GFDL/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - dependencies = ../../hooks/machine.F,../SFC_Layer/module_sf_exchcoef.f90,../../Land/RUC/namelist_soilveg_ruc.F90,../../Land/Noahmp/noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Layer/module_sf_exchcoef.f90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90,Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/GFS_sfc/date_def.f b/physics/SFC_Layer/UFS/date_def.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/date_def.f rename to physics/SFC_Layer/UFS/date_def.f diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_model.f90 b/physics/SFC_Layer/UFS/module_nst_model.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_model.f90 rename to physics/SFC_Layer/UFS/module_nst_model.f90 diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 b/physics/SFC_Layer/UFS/module_nst_parameters.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 rename to physics/SFC_Layer/UFS/module_nst_parameters.f90 diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 rename to physics/SFC_Layer/UFS/module_nst_water_prop.f90 diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag.f rename to physics/SFC_Layer/UFS/sfc_diag.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag.meta rename to physics/SFC_Layer/UFS/sfc_diag.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 b/physics/SFC_Layer/UFS/sfc_diag_post.F90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 rename to physics/SFC_Layer/UFS/sfc_diag_post.F90 diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta b/physics/SFC_Layer/UFS/sfc_diag_post.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta rename to physics/SFC_Layer/UFS/sfc_diag_post.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diff.f rename to physics/SFC_Layer/UFS/sfc_diff.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diff.meta rename to physics/SFC_Layer/UFS/sfc_diff.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst.f b/physics/SFC_Layer/UFS/sfc_nst.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst.f rename to physics/SFC_Layer/UFS/sfc_nst.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst.meta rename to physics/SFC_Layer/UFS/sfc_nst.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_post.f b/physics/SFC_Layer/UFS/sfc_nst_post.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_post.f rename to physics/SFC_Layer/UFS/sfc_nst_post.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta b/physics/SFC_Layer/UFS/sfc_nst_post.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta rename to physics/SFC_Layer/UFS/sfc_nst_post.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f b/physics/SFC_Layer/UFS/sfc_nst_pre.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f rename to physics/SFC_Layer/UFS/sfc_nst_pre.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta b/physics/SFC_Layer/UFS/sfc_nst_pre.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta rename to physics/SFC_Layer/UFS/sfc_nst_pre.meta diff --git a/physics/Land/CLM_lake/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 similarity index 100% rename from physics/Land/CLM_lake/clm_lake.f90 rename to physics/SFC_Models/Lake/CLM/clm_lake.f90 diff --git a/physics/Land/CLM_lake/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta similarity index 100% rename from physics/Land/CLM_lake/clm_lake.meta rename to physics/SFC_Models/Lake/CLM/clm_lake.meta diff --git a/physics/Land/Flake/flake.F90 b/physics/SFC_Models/Lake/Flake/flake.F90 similarity index 100% rename from physics/Land/Flake/flake.F90 rename to physics/SFC_Models/Lake/Flake/flake.F90 diff --git a/physics/Land/Flake/flake_driver.F90 b/physics/SFC_Models/Lake/Flake/flake_driver.F90 similarity index 100% rename from physics/Land/Flake/flake_driver.F90 rename to physics/SFC_Models/Lake/Flake/flake_driver.F90 diff --git a/physics/Land/Flake/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta similarity index 100% rename from physics/Land/Flake/flake_driver.meta rename to physics/SFC_Models/Lake/Flake/flake_driver.meta diff --git a/physics/Land/Noah/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f similarity index 100% rename from physics/Land/Noah/lsm_noah.f rename to physics/SFC_Models/Land/Noah/lsm_noah.f diff --git a/physics/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta similarity index 100% rename from physics/Land/Noah/lsm_noah.meta rename to physics/SFC_Models/Land/Noah/lsm_noah.meta diff --git a/physics/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f similarity index 100% rename from physics/Land/Noah/sflx.f rename to physics/SFC_Models/Land/Noah/sflx.f diff --git a/physics/Land/Noah/surface_perturbation.F90 b/physics/SFC_Models/Land/Noah/surface_perturbation.F90 similarity index 100% rename from physics/Land/Noah/surface_perturbation.F90 rename to physics/SFC_Models/Land/Noah/surface_perturbation.F90 diff --git a/physics/Land/Noahmp/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 similarity index 100% rename from physics/Land/Noahmp/module_sf_noahmp_glacier.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 diff --git a/physics/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 similarity index 100% rename from physics/Land/Noahmp/module_sf_noahmplsm.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 diff --git a/physics/Land/Noahmp/noahmp_tables.f90 b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 similarity index 100% rename from physics/Land/Noahmp/noahmp_tables.f90 rename to physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 similarity index 100% rename from physics/Land/Noahmp/noahmpdrv.F90 rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 diff --git a/physics/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta similarity index 100% rename from physics/Land/Noahmp/noahmpdrv.meta rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.meta diff --git a/physics/Land/Noahmp/noahmptable.tbl b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl similarity index 100% rename from physics/Land/Noahmp/noahmptable.tbl rename to physics/SFC_Models/Land/Noahmp/noahmptable.tbl diff --git a/physics/Land/RUC/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 similarity index 100% rename from physics/Land/RUC/lsm_ruc.F90 rename to physics/SFC_Models/Land/RUC/lsm_ruc.F90 diff --git a/physics/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta similarity index 100% rename from physics/Land/RUC/lsm_ruc.meta rename to physics/SFC_Models/Land/RUC/lsm_ruc.meta diff --git a/physics/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 similarity index 100% rename from physics/Land/RUC/module_sf_ruclsm.F90 rename to physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 diff --git a/physics/Land/RUC/module_soil_pre.F90 b/physics/SFC_Models/Land/RUC/module_soil_pre.F90 similarity index 100% rename from physics/Land/RUC/module_soil_pre.F90 rename to physics/SFC_Models/Land/RUC/module_soil_pre.F90 diff --git a/physics/Land/RUC/namelist_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 similarity index 100% rename from physics/Land/RUC/namelist_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 diff --git a/physics/Land/RUC/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 similarity index 100% rename from physics/Land/RUC/set_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 diff --git a/physics/Land/namelist_soilveg.f b/physics/SFC_Models/Land/namelist_soilveg.f similarity index 100% rename from physics/Land/namelist_soilveg.f rename to physics/SFC_Models/Land/namelist_soilveg.f diff --git a/physics/Land/set_soilveg.f b/physics/SFC_Models/Land/set_soilveg.f similarity index 100% rename from physics/Land/set_soilveg.f rename to physics/SFC_Models/Land/set_soilveg.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_ocean.F rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.F diff --git a/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_ocean.meta rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_cice.f b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_cice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_cice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_sice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_sice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.meta From f0117dfcf75a5fd0ea74383ae2b0f36c3df9d48e Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 12 Oct 2023 16:27:32 +0000 Subject: [PATCH 035/122] Changes in RUC LSM: 1. adding a heat source from fires. It is icontrolled by a flag and not turned on yet. Needs more testing. 2. Adding output of surface paramteres: leaf area index (LAI), wilting point and soil field capacity. --- physics/lsm_ruc.F90 | 105 ++++++++++++++++++++++++----------- physics/lsm_ruc.meta | 17 +++++- physics/module_sf_ruclsm.F90 | 29 +++++++++- 3 files changed, 115 insertions(+), 36 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index 665fe6d14..d3754b68c 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -359,6 +359,7 @@ subroutine lsm_ruc_run & ! inputs & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + & add_fire_heat_flux, fire_heat_flux_out, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -381,7 +382,7 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: oro, sigma real (kind_phys), dimension(:), intent(in) :: & - & t1, sigmaf, laixy, dlwflx, dswsfc, tg3, & + & t1, sigmaf, dlwflx, dswsfc, tg3, & & coszen, prsl1, wind, shdmin, shdmax, & & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land @@ -417,7 +418,7 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: zs real (kind_phys), dimension(:), intent(in) :: srflag real (kind_phys), dimension(:), intent(inout) :: & - & canopy, trans, smcwlt2, smcref2, & + & canopy, trans, smcwlt2, smcref2, laixy, & ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & & tsurf_lnd, z0rl_lnd, tsnow_lnd, & @@ -430,6 +431,8 @@ subroutine lsm_ruc_run & ! inputs ! --- in real (kind_phys), dimension(:), intent(in) :: & & rainnc, rainc, ice, snow, graupel, rhonewsn1 + real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out + logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels real (kind_phys), dimension(:,:), intent(inout) :: & @@ -505,12 +508,13 @@ subroutine lsm_ruc_run & ! inputs & solnet_lnd, sfcexc, & & runoff1, runoff2, acrunoff, semis_bck, & & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & + & fire_heat_flux1d, & & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & & soilt_lnd, tbot, & & xlai, swdn, z0_lnd, znt_lnd, rhosnfr, infiltr, & - & precipfr, snfallac_lnd, acsn_lnd, & - & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, soilt1_lnd, chklowq + & precipfr, snfallac_lnd, acsn_lnd, soilt1_lnd, chklowq, & + & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, smcwlt, smcref ! ice real (kind_phys),dimension (im,1) :: & & albbck_ice, alb_ice, chs_ice, flhc_ice, flqc_ice, & @@ -540,7 +544,7 @@ subroutine lsm_ruc_run & ! inputs integer :: l, k, i, j, fractional_seaice, ilst real (kind_phys) :: dm, cimin(im) logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im) - logical :: rdlai2d, myj, frpcpn + logical :: myj, frpcpn logical :: debug_print !-- diagnostic point @@ -645,15 +649,38 @@ subroutine lsm_ruc_run & ! inputs nsoil = lsoil_ruc do i = 1, im ! i - horizontal loop - ! reassign smcref2 and smcwlt2 to RUC values - if(.not. land(i)) then - !water and sea ice - smcref2 (i) = one - smcwlt2 (i) = zero + ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 + if(kdt == 1) then + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + else + !land + smcref (i,1) = REFSMC(stype(i)) + smcwlt (i,1) = WLTSMC(stype(i)) + + !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start + if(rdlai) then + xlai(i,1) = laixy(i) + else + xlai(i,1) = LAITBL(vtype(i)) + endif + endif else - !land - smcref2 (i) = REFSMC(stype(i)) - smcwlt2 (i) = WLTSMC(stype(i)) + !-- if kdt > 1, parameters with sub-grid heterogeneity + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + else + !land + smcref (i,1) = smcref2 (i) + smcwlt (i,1) = smcwlt2 (i) + xlai (i,1) = laixy (i) + endif endif enddo @@ -813,10 +840,6 @@ subroutine lsm_ruc_run & ! inputs ffrozp(i,j) = real(nint(srflag(i)),kind_phys) endif - !-- rdlai is .false. when the LAI data is not available in the - ! - INPUT/sfc_data.nc - - rdlai2d = rdlai conflx2(i,1,j) = zf(i) * 2._kind_phys ! factor 2. is needed to get the height of ! atm. forcing inside RUC LSM (inherited @@ -843,14 +866,15 @@ subroutine lsm_ruc_run & ! inputs !!\n \a graupelncv - time-step graupel (\f$kg m^{-2} \f$) !!\n \a snowncv - time-step snow (\f$kg m^{-2} \f$) !!\n \a precipfr - time-step precipitation in solid form (\f$kg m^{-2} \f$) -!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-1.0) -!!\n \a shdmin - minimum areal fractional coverage of green vegetation -> !shdmin1d -!!\n \a shdmax - maximum areal fractional coverage of green vegetation -> !shdmax1d +!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-100.%) +!!\n \a shdmin - minimum areal fractional coverage of green vegetation in % -> !shdmin1d +!!\n \a shdmax - maximum areal fractional coverage of green vegetation in % -> !shdmax1d !!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp) lwdn(i,j) = dlwflx(i) !..downward lw flux at sfc in w/m2 swdn(i,j) = dswsfc(i) !..downward sw flux at sfc in w/m2 + ! all precip input to RUC LSM is in [mm] !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip @@ -918,17 +942,12 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'MODIS landuse is not available' endif - if(rdlai2d) then - xlai(i,j) = laixy(i) - else - xlai(i,j) = zero - endif - semis_bck(i,j) = semisbase(i) ! --- units % shdfac(i,j) = sigmaf(i)*100._kind_phys shdmin1d(i,j) = shdmin(i)*100._kind_phys shdmax1d(i,j) = shdmax(i)*100._kind_phys + fire_heat_flux1d(i,j) = fire_heat_flux_out(i) ! JLS if (land(i)) then ! at least some land in the grid cell @@ -976,6 +995,12 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i) + IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS + ! limit albedo and greenness in the areas affected by the fire + albbck_lnd(i,j) = min(0.1_kind_phys,albbck_lnd(i,j)) + shdfac(i,j) = min(50._kind_phys,shdfac(i,j)) ! % + ENDIF + !-- spp_lsm if (spp_lsm == 1) then @@ -1163,7 +1188,7 @@ subroutine lsm_ruc_run & ! inputs & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & & z0_lnd(i,j), snoalb1d_lnd(i,j), albbck_lnd(i,j), & & xlai(i,j), landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_lnd(i,j), qsg_lnd(i,j), qvg_lnd(i,j), qcg_lnd(i,j), & & dew_lnd(i,j), soilt1_lnd(i,j), & & tsnav_lnd(i,j), tbot(i,j), vtype_lnd(i,j), stype_lnd(i,j), & @@ -1178,8 +1203,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_lnd(i,j), & & snfallac_lnd(i,j), acsn_lnd(i,j), snomlt_lnd(i,j), & - & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrsoil(i,:,j),keepfrsoil(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(debug_print) then @@ -1218,7 +1244,7 @@ subroutine lsm_ruc_run & ! inputs 'ssoil(i,j) =',ssoil_lnd(i,j), & 'snfallac(i,j) =',snfallac_lnd(i,j), & 'acsn_lnd(i,j) =',acsn_lnd(i,j), & - 'snomlt(i,j) =',snomlt_lnd(i,j) + 'snomlt(i,j) =',snomlt_lnd(i,j),'xlai(i,j) =',xlai(i,j) endif endif @@ -1289,6 +1315,10 @@ subroutine lsm_ruc_run & ! inputs ! --- ... unit conversion (from m to mm) snwdph_lnd(i) = snowh_lnd(i,j) * rhoh2o + laixy(i) = xlai(i,j) + smcwlt2(i) = smcwlt(i,j) + smcref2(i) = smcref(i,j) + canopy(i) = cmc(i,j) ! mm weasd_lnd(i) = sneqv_lnd(i,j) ! mm sncovr1_lnd(i) = sncovr_lnd(i,j) @@ -1318,6 +1348,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'LAND -i,j,stype_lnd,vtype_lnd',i,j,stype_lnd(i,j),vtype_lnd(i,j) write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i) write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! end of land @@ -1449,7 +1480,7 @@ subroutine lsm_ruc_run & ! inputs & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & & znt_ice(i,j), z0_ice(i,j), snoalb1d_ice(i,j), & & albbck_ice(i,j), xlai(i,j),landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_ice(i,j), qsg_ice(i,j), qvg_ice(i,j), qcg_ice(i,j), & & dew_ice(i,j), soilt1_ice(i,j), & & tsnav_ice(i,j), tbot(i,j), vtype_ice(i,j), stype_ice(i,j), & @@ -1464,8 +1495,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & & snfallac_ice(i,j), acsn_ice(i,j), snomlt_ice(i,j), & - & smfrice(i,:,j),keepfrice(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrice(i,:,j),keepfrice(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, & & errmsg, errflg) @@ -1502,6 +1534,10 @@ subroutine lsm_ruc_run & ! inputs albivis_ice(i) = sfalb_ice(i) albinir_ice(i) = sfalb_ice(i) + laixy(i) = zero + smcwlt2(i) = zero + smcref2(i) = one + stm(i) = 3.e3_kind_phys ! kg m-2 do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) @@ -1517,6 +1553,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'ICE - i,j,stype_ice,vtype_ice)',i,j,stype_ice(i,j),vtype_ice(i,j) write (0,*)'i,j,tsurf_ice(i)',i,j,tsurf_ice(i) write (0,*)'kdt,iter,stsice(i,:,j)',kdt,iter,stsice(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! ice @@ -1762,6 +1799,8 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in tbot(i,j) = tg3(i) ivgtyp(i,j) = vtype(i) isltyp(i,j) = stype(i) + if(isltyp(i,j)==0) isltyp(i,j)=14 + if(ivgtyp(i,j)==0) ivgtyp(i,j)=17 if (landfrac(i) > zero .or. fice(i) > zero) then !-- land or ice tsk(i,j) = tskin_lnd(i) diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 34a5b8a8b..4cc6a9419 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -813,7 +813,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [dlwflx] standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time @@ -1747,6 +1747,21 @@ dimensions = () type = logical intent = in +[add_fire_heat_flux] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical + intent = in +[fire_heat_flux_out] + standard_name = surface_fire_heat_flux + long_name = heat flux of fire at the surface + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 160127e43..2bb29d440 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -97,6 +97,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & MAVAIL,CANWAT,VEGFRA, & ALB,ZNT,Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, soilctop, nscat, & + smcwlt, smcref, & QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV, & TBOT,IVGTYP,ISLTYP,XLAND, & ISWATER,ISICE,XICE,XICE_THRESHOLD, & @@ -107,6 +108,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & RUNOFF1,RUNOFF2,ACRUNOFF,SFCEXC, & SFCEVP,GRDFLX,SNOWFALLAC,ACSNOW,SNOM, & SMFR3D,KEEPFR3DFLAG, & + add_fire_heat_flux,fire_heat_flux, & myj,shdmin,shdmax,rdlai2d, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -239,6 +241,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: hgt real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: stdev + LOGICAL, intent(in) :: add_fire_heat_flux + real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: fire_heat_flux LOGICAL, intent(in) :: rdlai2d real (kind_phys), DIMENSION( 1:nsl), INTENT(IN ) :: ZS @@ -252,6 +256,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & SNOALB, & ALB, & LAI, & + SMCWLT, & + SMCREF, & EMISS, & EMISBCK, & MAVAIL, & @@ -757,6 +763,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & !-- update background emissivity for land points, can have vegetation mosaic effect EMISBCK(I,J) = EMISSL(I,J) + smcwlt(i,j) = wilt + smcref(i,j) = ref IF (debug_print ) THEN if(init)then @@ -961,6 +969,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & snoalb(i,j),albbck(i,j),lai(i,j), & hgt(i,j),stdev(i,j), & !new myj,seaice(i,j),isice, & + add_fire_heat_flux,fire_heat_flux(i,j), & !--- soil fixed fields QWRTZ, & rhocs,dqm,qmin,ref, & @@ -1212,6 +1221,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia QKMS,TKMS,PC,MAVAIL,CST,VEGFRA,ALB,ZNT, & ALB_SNOW,ALB_SNOW_FREE,lai,hgt,stdev, & MYJ,SEAICE,ISICE, & + add_fire_heat_flux,fire_heat_flux, & QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat, & !--- soil fixed fields sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq, & cp,rovcp,g0,lv,stbolt,cw,c1sn,c2sn, & !--- constants @@ -1256,7 +1266,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia SEAICE, & RHO, & QKMS, & - TKMS + TKMS, & + fire_heat_flux + LOGICAL, INTENT(IN ) :: add_fire_heat_flux INTEGER, INTENT(IN ) :: IVGTYP, ISLTYP !--- 2-D variables @@ -1813,6 +1825,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia UPFLUX = T3 *SOILT XINET = EMISS_snowfree*(GLW-UPFLUX) RNET = GSWnew + XINET + IF ( add_fire_heat_flux ) then ! JLS + RNET = RNET + fire_heat_flux + ENDIF + IF (debug_print ) THEN print *,'Fractional snow - snowfrac=',snowfrac print *,'Snowfrac<1 GSWin,GSWnew -',GSWin,GSWnew,'SOILT, RNET',soilt,rnet @@ -1933,6 +1949,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if (SEAICE .LT. 0.5_kind_phys) then ! LAND + IF ( add_fire_heat_flux ) then ! JLS + RNET = RNET + fire_heat_flux + ENDIF if(snow_mosaic==one)then snfr=one else @@ -2049,6 +2068,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac + !IF ( add_fire_heat_flux ) then ! JLS + ! hfx = hfx + fire_heat_flux + !ENDIF s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) sublim = sublim*snowfrac @@ -2094,6 +2116,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac + !IF ( add_fire_heat_flux ) then ! JLS + ! hfx = hfx + fire_heat_flux + !ENDIF s = ss*(one-snowfrac) + s*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac @@ -6611,7 +6636,7 @@ SUBROUTINE TRANSF( debug_print, & /(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution -! TRANF(k)=part(k) + TRANF(k)=part(k) END DO ! For LAI> 3 => transpiration at potential rate (F.Tardieu, 2013) From 876a1ac17df62f40a936418da7f22b15923bc10c Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 12 Oct 2023 19:34:14 +0000 Subject: [PATCH 036/122] Fire heat flux computation is added to the smoke-dust code. --- physics/smoke_dust/module_plumerise1.F90 | 4 ++++ physics/smoke_dust/module_smoke_plumerise.F90 | 12 ++++++++++-- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 13 ++++++++++--- physics/smoke_dust/rrfs_smoke_wrapper.meta | 8 ++++++++ 4 files changed, 32 insertions(+), 5 deletions(-) diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 3c23faa6a..189bf981a 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -38,6 +38,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags + fire_heat_flux,dxy, & plume_frp, k_min, k_max, & ! RAR: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -66,6 +67,8 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: fire_heat_flux + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: dxy ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -184,6 +187,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & + fire_heat_flux(i,j),dxy(i,j), & plume_frp(i,j,1), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 61be06181..9c0dfa49d 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -28,6 +28,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & + fire_heat_flux, dxy, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) @@ -43,6 +44,9 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies + real(kind=kind_phys), intent(in) :: dxy + real(kind=kind_phys), intent(out) :: fire_heat_flux ! JLS + INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -106,6 +110,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & IF (frp_inst Date: Thu, 12 Oct 2023 21:31:36 +0000 Subject: [PATCH 037/122] Fix the segmentation fault error in computing fire heat flux. --- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index f9b15a494..e6a398363 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -353,10 +353,10 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(errflg/=0) return - end if - do i = its,ite + do i = its,ite fire_heat_flux_out(i) = min(max(0.,fire_heat_flux(i,1)),50000.) ! JLS - W m-2 [0 - 10,000] - enddo + enddo + end if ! -- add biomass burning emissions at every timestep if (addsmoke_flag == 1) then call add_emis_burn(dt,dz8w,rho_phy,rel_hum,chem, & From 4e45989d1f6f78bb05aa789289d4cebebe9217b7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 09:46:45 -0400 Subject: [PATCH 038/122] Code update for HR4_roughness --- physics/sfc_diff.f | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..561a087c4 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -348,12 +348,26 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) & * virtfac endif - - z0 = 0.01_kp * z0rl_wat(i) - z0max = max(zmin, min(z0,z1(i))) -! ustar_wat(i) = sqrt(grav * z0 / charnock) +! wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) +! + if (sfc_z0_type == -1) then ! using wave model derived momentum roughness + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + 0.01_kp * z0rl_wav(i) + if (redrag) then + z0max = max(min(z0, z0s_max),1.0e-7_kp) + else + z0max = max(min(z0,0.1_kp), 1.0e-7_kp) + endif + z0rl_wat(i) = 100.0_kp * z0max ! cm + else + z0 = 0.01_kp * z0rl_wat(i) + z0max = max(zmin, min(z0,z1(i))) + endif +! +! ustar_wat(i) = sqrt(grav * z0 / charnock) +! !** test xubin's new z0 ! ztmax = z0max @@ -423,17 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif - elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & - & z0rl_wav(i) > 1.0_kp) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) +! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & +! & z0rl_wav(i) > 1.0_kp) then +!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) +! tem1 = 0.11 * vis / ustar_wat(i) +! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + +! if (redrag) then +! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) +! else +! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) +! endif - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) - endif endif endif ! end of if(open ocean) From 3debf89fdc94111624f0b99da71e605418824183 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:45:21 -0400 Subject: [PATCH 039/122] Code update for HR4_roughness --- physics/sfc_diff.f | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 561a087c4..d56308b79 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -437,18 +437,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif -! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & -! & z0rl_wav(i) > 1.0_kp) then -!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) -! tem1 = 0.11 * vis / ustar_wat(i) -! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) - -! if (redrag) then -! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) -! else -! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) -! endif - endif endif ! end of if(open ocean) From c2b130113acf235e7c5e65bfd5f97ca2e8e3a3d7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:55:07 -0400 Subject: [PATCH 040/122] Code update for HR4_roughness --- physics/sfc_diff.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index d56308b79..b28daef3b 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -366,8 +366,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(zmin, min(z0,z1(i))) endif ! -! ustar_wat(i) = sqrt(grav * z0 / charnock) -! !** test xubin's new z0 ! ztmax = z0max From 16e640eca60eeadb77078c2cf251f99fd7a8f469 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 16 Oct 2023 19:25:15 +0000 Subject: [PATCH 041/122] updates from HFIP dev branch --- physics/GFS_debug.F90 | 4 +- physics/module_bl_mynn.F90 | 1579 ++++++++++++++++---------------- physics/module_mp_thompson.F90 | 19 +- physics/module_sf_mynn.F90 | 6 +- physics/mynnedmf_wrapper.F90 | 13 +- physics/mynnedmf_wrapper.meta | 21 +- 6 files changed, 845 insertions(+), 797 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index fe63c1cea..ed26b795f 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -747,9 +747,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_thl ', Diag%det_thl) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_sqv ', Diag%det_sqv) end if - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nupdraft ', Diag%nupdraft) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxwidth ', Diag%maxwidth) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ktop_plume ', Diag%ktop_plume) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ztop_plume ', Diag%ztop_plume) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index ec6b5700d..943a5c81d 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,5 +1,5 @@ !>\file module_bl_mynn.F90 -!! This file contains the entity of MYNN-EDMF PBL scheme. +! This file contains the entity of MYNN-EDMF PBL scheme. ! ********************************************************************** ! * An improved Mellor-Yamada turbulence closure model * ! * * @@ -256,11 +256,11 @@ MODULE module_bl_mynn !=================================================================== ! From here on, these are MYNN-specific parameters: ! The parameters below depend on stability functions of module_sf_mynn. - real(kind_phys), PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & + real(kind_phys), parameter :: cphm_st=5.0, cphm_unst=16.0, & cphh_st=5.0, cphh_unst=16.0 ! Closure constants - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &pr = 0.74, & &g1 = 0.235, & ! NN2009 = 0.235 &b1 = 24.0, & @@ -275,7 +275,7 @@ MODULE module_bl_mynn &a2 = a1*( g1-c1 )/( g1*pr ), & &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &cc2 = 1.0-c2, & &cc3 = 1.0-c3, & &e1c = 3.0*a2*b2*cc3, & @@ -286,15 +286,15 @@ MODULE module_bl_mynn ! Constants for min tke in elt integration (qmin), max z/L in els (zmax), ! and factor for eddy viscosity for TKE (Kq = Sqfac*Km): - real(kind_phys), PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 + real(kind_phys), parameter :: qmin=0.0, zmax=1.0, Sqfac=3.0 ! Note that the following mixing-length constants are now specified in mym_length ! &cns=3.5, alp1=0.23, alp2=0.3, alp3=3.0, alp4=10.0, alp5=0.2 - real(kind_phys), PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - real(kind_phys), PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq + real(kind_phys), parameter :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 + real(kind_phys), parameter :: tliq = 269. !all hydrometeors are liquid when T > tliq ! Constants for cloud PDF (mym_condensation) - real(kind_phys), PARAMETER :: rr2=0.7071068, rrp=0.3989423 + real(kind_phys), parameter :: rr2=0.7071068, rrp=0.3989423 !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -304,35 +304,35 @@ MODULE module_bl_mynn !!(above) back to NN2009 values (see commented out lines next to the !!parameters above). This only removes the negative TKE problem !!but does not necessarily improve performance - neutral impact. - real(kind_phys), PARAMETER :: CKmod=1. + real(kind_phys), parameter :: CKmod=1. !>Use Ito et al. (2015, BLM) scale-aware (0: no, 1: yes). Note that this also has impacts !!on the cloud PDF and mass-flux scheme, using Honnert et al. (2011) similarity function !!for TKE in the upper PBL/cloud layer. - real(kind_phys), PARAMETER :: scaleaware=1. + real(kind_phys), parameter :: scaleaware=1. !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling - INTEGER, PARAMETER :: bl_mynn_topdown = 0 + integer, parameter :: bl_mynn_topdown = 0 !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) - INTEGER, PARAMETER :: bl_mynn_edmf_dd = 0 + integer, parameter :: bl_mynn_edmf_dd = 0 !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) - INTEGER, PARAMETER :: dheat_opt = 1 + integer, parameter :: dheat_opt = 1 !Option to activate environmental subsidence in mass-flux scheme - LOGICAL, PARAMETER :: env_subs = .false. + logical, parameter :: env_subs = .false. !Option to switch flux-profile relationship for surface (from Puhales et al. 2020) !0: use original Dyer-Hicks, 1: use Cheng-Brustaert and Blended COARE - INTEGER, PARAMETER :: bl_mynn_stfunc = 1 + integer, parameter :: bl_mynn_stfunc = 1 !option to print out more stuff for debugging purposes - LOGICAL, PARAMETER :: debug_code = .false. - INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out + logical, parameter :: debug_code = .false. + integer, parameter :: idbg = 23 !specific i-point to write out ! Used in WRF-ARW module_physics_init.F - INTEGER :: mynn_level + integer :: mynn_level CONTAINS @@ -388,7 +388,8 @@ SUBROUTINE mynn_bl_driver( & &edmf_thl,edmf_ent,edmf_qc, & &sub_thl3D,sub_sqv3D, & &det_thl3D,det_sqv3D, & - &nupdraft,maxMF,ktop_plume, & + &maxwidth,maxMF,ztop_plume, & + &ktop_plume, & &spp_pbl,pattern_spp_pbl, & &rthraten, & &FLAG_QC,FLAG_QI,FLAG_QNC, & @@ -401,30 +402,30 @@ SUBROUTINE mynn_bl_driver( & !------------------------------------------------------------------- - INTEGER, INTENT(in) :: initflag + integer, intent(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(in) :: restart,cycling - INTEGER, INTENT(in) :: tke_budget - INTEGER, INTENT(in) :: bl_mynn_cloudpdf - INTEGER, INTENT(in) :: bl_mynn_mixlength - INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(in) :: bl_mynn_tkeadvect - INTEGER, INTENT(in) :: bl_mynn_edmf_mom - INTEGER, INTENT(in) :: bl_mynn_edmf_tke - INTEGER, INTENT(in) :: bl_mynn_mixscalars - INTEGER, INTENT(in) :: bl_mynn_output - INTEGER, INTENT(in) :: bl_mynn_cloudmix - INTEGER, INTENT(in) :: bl_mynn_mixqt - INTEGER, INTENT(in) :: icloud_bl - real(kind_phys), INTENT(in) :: closure - - LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + logical, intent(in) :: restart,cycling + integer, intent(in) :: tke_budget + integer, intent(in) :: bl_mynn_cloudpdf + integer, intent(in) :: bl_mynn_mixlength + integer, intent(in) :: bl_mynn_edmf + logical, intent(in) :: bl_mynn_tkeadvect + integer, intent(in) :: bl_mynn_edmf_mom + integer, intent(in) :: bl_mynn_edmf_tke + integer, intent(in) :: bl_mynn_mixscalars + integer, intent(in) :: bl_mynn_output + integer, intent(in) :: bl_mynn_cloudmix + integer, intent(in) :: bl_mynn_mixqt + integer, intent(in) :: icloud_bl + real(kind_phys), intent(in) :: closure + + logical, intent(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & FLAG_OZONE,FLAG_QS - LOGICAL, INTENT(IN) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg + logical, intent(in) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg - INTEGER, INTENT(in) :: & + integer, intent(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & &,ITS,ITE,JTS,JTE,KTS,KTE @@ -444,81 +445,82 @@ SUBROUTINE mynn_bl_driver( & ! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs ! on Cheyenne with the GNU compiler. - real(kind_phys), INTENT(in) :: delt - real(kind_phys), DIMENSION(:), INTENT(in) :: dx - real(kind_phys), DIMENSION(:,:), INTENT(in) :: dz, & + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(:), intent(in) :: dx + real(kind_phys), dimension(:,:), intent(in) :: dz, & &u,v,w,th,sqv3D,p,exner,rho,T3D - real(kind_phys), DIMENSION(:,:), INTENT(in) :: & + real(kind_phys), dimension(:,:), intent(in) :: & &sqc3D,sqi3D,sqs3D,qni,qnc,qnwfa,qnifa,qnbca - real(kind_phys), DIMENSION(:,:), INTENT(in):: ozone - real(kind_phys), DIMENSION(:), INTENT(in):: ust, & + real(kind_phys), dimension(:,:), intent(in):: ozone + real(kind_phys), dimension(:), intent(in):: ust, & &ch,qsfc,ps,wspd - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &Qke,Tsq,Qsq,Cov,qke_adv - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &rublten,rvblten,rthblten,rqvblten,rqcblten, & &rqiblten,rqsblten,rqniblten,rqncblten, & &rqnwfablten,rqnifablten,rqnbcablten - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: dozone - real(kind_phys), DIMENSION(:,:), INTENT(in) :: rthraten + real(kind_phys), dimension(:,:), intent(inout) :: dozone + real(kind_phys), dimension(:,:), intent(in) :: rthraten - real(kind_phys), DIMENSION(:,:), INTENT(out) :: exch_h,exch_m - real(kind_phys), DIMENSION(:), INTENT(in) :: xland, & + real(kind_phys), dimension(:,:), intent(out) :: exch_h,exch_m + real(kind_phys), dimension(:), intent(in) :: xland, & &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D -! real, DIMENSION(IMS:IME,KMS:KME) :: & +! real, dimension(ims:ime,kms:kme) :: & ! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - real(kind_phys), DIMENSION(:), INTENT(inout) :: Pblh - real(kind_phys), DIMENSION(:), INTENT(inout) :: rmol + real(kind_phys), dimension(:), intent(inout) :: Pblh + real(kind_phys), dimension(:), intent(inout) :: rmol - real(kind_phys), DIMENSION(IMS:IME) :: psig_bl,psig_shcu + real(kind_phys), dimension(ims:ime) :: psig_bl,psig_shcu - INTEGER,DIMENSION(:),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_plume + integer,dimension(:),intent(INOUT) :: & + &KPBL,ktop_plume - real(kind_phys), DIMENSION(:), INTENT(out) :: maxmf + real(kind_phys), dimension(:), intent(out) :: & + &maxmf,maxwidth,ztop_plume - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: el_pbl + real(kind_phys), dimension(:,:), intent(inout) :: el_pbl - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte) :: & &qwt1,qshear1,qbuoy1,qdiss1,dqke1,diss_heat - real(kind_phys), DIMENSION(:,:), intent(out) :: Sh3D,Sm3D + real(kind_phys), dimension(:,:), intent(out) :: Sh3D,Sm3D - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &qc_bl,qi_bl,cldfra_bl - real(kind_phys), DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays - INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION(:,:,:), INTENT(INOUT) :: chem3d - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: vdep - real(kind_phys), DIMENSION(:), INTENT(IN) :: frp,EMIS_ANT_NO + integer, intent(IN ) :: nchem, kdvel, ndvel + real(kind_phys), dimension(:,:,:), intent(INOUT) :: chem3d + real(kind_phys), dimension(:,:), intent(IN) :: vdep + real(kind_phys), dimension(:), intent(IN) :: frp,EMIS_ANT_NO !local - real(kind_phys), DIMENSION(kts:kte ,nchem) :: chem1 - real(kind_phys), DIMENSION(kts:kte+1,nchem) :: s_awchem1 - real(kind_phys), DIMENSION(ndvel) :: vd1 - INTEGER :: ic + real(kind_phys), dimension(kts:kte ,nchem) :: chem1 + real(kind_phys), dimension(kts:kte+1,nchem) :: s_awchem1 + real(kind_phys), dimension(ndvel) :: vd1 + integer :: ic !local vars - INTEGER :: ITF,JTF,KTF, IMD,JMD - INTEGER :: i,j,k,kproblem - real(kind_phys), DIMENSION(KTS:KTE) :: & + integer :: ITF,JTF,KTF, IMD,JMD + integer :: i,j,k,kproblem + real(kind_phys), dimension(kts:kte) :: & &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & &vt, vq, sgm - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & &sqv,sqi,sqc,sqs, & @@ -527,45 +529,45 @@ SUBROUTINE mynn_bl_driver( & &qnbca1,dqnwfa1,dqnifa1,dqnbca1,dozone1 !mass-flux variables - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a1,edmf_w1,edmf_qt1,edmf_thl1, & &edmf_ent1,edmf_qc1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1, & &edmf_ent_dd1,edmf_qc_dd1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &sub_thl,sub_sqv,sub_u,sub_v, & &det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & &s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & &s_awqnbca1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &sd_aw1,sd_awthl1,sd_awqt1, & &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: zw + real(kind_phys), dimension(kts:kte+1) :: zw real(kind_phys) :: cpm,sqcg,flt,fltv,flq,flqv,flqc, & &pmz,phh,exnerg,zet,phi_m, & &afk,abk,ts_decay, qc_bl2, qi_bl2, & - &th_sfc,ztop_plume,wsp + &th_sfc,wsp !top-down diffusion - real(kind_phys), DIMENSION(ITS:ITE) :: maxKHtopdown - real(kind_phys), DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD + real(kind_phys), dimension(ITS:ITE) :: maxKHtopdown + real(kind_phys), dimension(kts:kte) :: KHtopdown,TKEprodTD - LOGICAL :: INITIALIZE_QKE,problem + logical :: INITIALIZE_QKE,problem ! Stochastic fields - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: pattern_spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(IN) :: spp_pbl + real(kind_phys), dimension(:,:), intent(IN) :: pattern_spp_pbl + real(kind_phys), dimension(KTS:KTE) :: rstoch_col ! Substepping TKE - INTEGER :: nsub + integer :: nsub real(kind_phys) :: delt2 @@ -629,7 +631,8 @@ SUBROUTINE mynn_bl_driver( & !edmf_qc_dd(its:ite,kts:kte)=0. ENDIF ktop_plume(its:ite)=0 !int - nupdraft(its:ite)=0 !int + ztop_plume(its:ite)=0. + maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. @@ -1021,7 +1024,7 @@ SUBROUTINE mynn_bl_driver( & endif s_awchem1 = 0.0 -!> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ +!> - Call get_pblh() to calculate the hybrid \f$\theta_{v}-TKE\f$ !! PBL height diagnostic. CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& & Qke1,zw,dz1,xland(i),KPBL(i)) @@ -1147,8 +1150,8 @@ SUBROUTINE mynn_bl_driver( & &FLAG_QNC,FLAG_QNI, & &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & &Psig_shcu(i), & - &nupdraft(i),ktop_plume(i), & - &maxmf(i),ztop_plume, & + &maxwidth(i),ktop_plume(i), & + &maxmf(i),ztop_plume(i), & &spp_pbl,rstoch_col ) endif @@ -1295,27 +1298,27 @@ SUBROUTINE mynn_bl_driver( & &dfm, dfh, dz1, K_m1, K_h1 ) !UPDATE 3D ARRAYS - exch_m(i,:) =k_m1(:) - exch_h(i,:) =k_h1(:) - rublten(i,:) =du1(:) - rvblten(i,:) =dv1(:) - rthblten(i,:)=dth1(:) - rqvblten(i,:)=dqv1(:) + exch_m(i,kts:kte) =k_m1(kts:kte) + exch_h(i,kts:kte) =k_h1(kts:kte) + rublten(i,kts:kte) =du1(kts:kte) + rvblten(i,kts:kte) =dv1(kts:kte) + rthblten(i,kts:kte)=dth1(kts:kte) + rqvblten(i,kts:kte)=dqv1(kts:kte) if (bl_mynn_cloudmix > 0) then - if (flag_qc) rqcblten(i,:)=dqc1(:) - if (flag_qi) rqiblten(i,:)=dqi1(:) - if (flag_qs) rqsblten(i,:)=dqs1(:) + if (flag_qc) rqcblten(i,kts:kte)=dqc1(kts:kte) + if (flag_qi) rqiblten(i,kts:kte)=dqi1(kts:kte) + if (flag_qs) rqsblten(i,kts:kte)=dqs1(kts:kte) else if (flag_qc) rqcblten(i,:)=0. if (flag_qi) rqiblten(i,:)=0. if (flag_qs) rqsblten(i,:)=0. endif if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then - if (flag_qnc) rqncblten(i,:) =dqnc1(:) - if (flag_qni) rqniblten(i,:) =dqni1(:) - if (flag_qnwfa) rqnwfablten(i,:)=dqnwfa1(:) - if (flag_qnifa) rqnifablten(i,:)=dqnifa1(:) - if (flag_qnbca) rqnbcablten(i,:)=dqnbca1(:) + if (flag_qnc) rqncblten(i,kts:kte) =dqnc1(kts:kte) + if (flag_qni) rqniblten(i,kts:kte) =dqni1(kts:kte) + if (flag_qnwfa) rqnwfablten(i,kts:kte)=dqnwfa1(kts:kte) + if (flag_qnifa) rqnifablten(i,kts:kte)=dqnifa1(kts:kte) + if (flag_qnbca) rqnbcablten(i,kts:kte)=dqnbca1(kts:kte) else if (flag_qnc) rqncblten(i,:) =0. if (flag_qni) rqniblten(i,:) =0. @@ -1323,19 +1326,19 @@ SUBROUTINE mynn_bl_driver( & if (flag_qnifa) rqnifablten(i,:)=0. if (flag_qnbca) rqnbcablten(i,:)=0. endif - dozone(i,:)=dozone1(:) + dozone(i,kts:kte)=dozone1(kts:kte) if (icloud_bl > 0) then - qc_bl(i,:) =qc_bl1D(:) - qi_bl(i,:) =qi_bl1D(:) - cldfra_bl(i,:)=cldfra_bl1D(:) + qc_bl(i,kts:kte) =qc_bl1D(kts:kte) + qi_bl(i,kts:kte) =qi_bl1D(kts:kte) + cldfra_bl(i,kts:kte)=cldfra_bl1D(kts:kte) endif - el_pbl(i,:)=el(:) - qke(i,:) =qke1(:) - tsq(i,:) =tsq1(:) - qsq(i,:) =qsq1(:) - cov(i,:) =cov1(:) - sh3d(i,:) =sh(:) - sm3d(i,:) =sm(:) + el_pbl(i,kts:kte)=el(kts:kte) + qke(i,kts:kte) =qke1(kts:kte) + tsq(i,kts:kte) =tsq1(kts:kte) + qsq(i,kts:kte) =qsq1(kts:kte) + cov(i,kts:kte) =cov1(kts:kte) + sh3d(i,kts:kte) =sh(kts:kte) + sm3d(i,kts:kte) =sm(kts:kte) if (tke_budget .eq. 1) then !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) @@ -1363,24 +1366,24 @@ SUBROUTINE mynn_bl_driver( & !update updraft/downdraft properties if (bl_mynn_output > 0) then !research mode == 1 if (bl_mynn_edmf > 0) then - edmf_a(i,:) =edmf_a1(:) - edmf_w(i,:) =edmf_w1(:) - edmf_qt(i,:) =edmf_qt1(:) - edmf_thl(i,:) =edmf_thl1(:) - edmf_ent(i,:) =edmf_ent1(:) - edmf_qc(i,:) =edmf_qc1(:) - sub_thl3D(i,:)=sub_thl(:) - sub_sqv3D(i,:)=sub_sqv(:) - det_thl3D(i,:)=det_thl(:) - det_sqv3D(i,:)=det_sqv(:) + edmf_a(i,kts:kte) =edmf_a1(kts:kte) + edmf_w(i,kts:kte) =edmf_w1(kts:kte) + edmf_qt(i,kts:kte) =edmf_qt1(kts:kte) + edmf_thl(i,kts:kte) =edmf_thl1(kts:kte) + edmf_ent(i,kts:kte) =edmf_ent1(kts:kte) + edmf_qc(i,kts:kte) =edmf_qc1(kts:kte) + sub_thl3D(i,kts:kte)=sub_thl(kts:kte) + sub_sqv3D(i,kts:kte)=sub_sqv(kts:kte) + det_thl3D(i,kts:kte)=det_thl(kts:kte) + det_sqv3D(i,kts:kte)=det_sqv(kts:kte) endif !if (bl_mynn_edmf_dd > 0) THEN - ! edmf_a_dd(i,:) =edmf_a_dd1(:) - ! edmf_w_dd(i,:) =edmf_w_dd1(:) - ! edmf_qt_dd(i,:) =edmf_qt_dd1(:) - ! edmf_thl_dd(i,:)=edmf_thl_dd1(:) - ! edmf_ent_dd(i,:)=edmf_ent_dd1(:) - ! edmf_qc_dd(i,:) =edmf_qc_dd1(:) + ! edmf_a_dd(i,kts:kte) =edmf_a_dd1(kts:kte) + ! edmf_w_dd(i,kts:kte) =edmf_w_dd1(kts:kte) + ! edmf_qt_dd(i,kts:kte) =edmf_qt_dd1(kts:kte) + ! edmf_thl_dd(i,kts:kte)=edmf_thl_dd1(kts:kte) + ! edmf_ent_dd(i,kts:kte)=edmf_ent_dd1(kts:kte) + ! edmf_qc_dd(i,kts:kte) =edmf_qc_dd1(kts:kte) !endif endif @@ -1509,27 +1512,27 @@ SUBROUTINE mym_initialize ( & ! !------------------------------------------------------------------- - integer, INTENT(IN) :: kts,kte - integer, INTENT(IN) :: bl_mynn_mixlength - logical, INTENT(IN) :: INITIALIZE_QKE -! real(kind_phys), INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - real(kind_phys), INTENT(IN) :: rmo, Psig_bl, xland - real(kind_phys), INTENT(IN) :: dx, ust, zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,& + integer, intent(in) :: kts,kte + integer, intent(in) :: bl_mynn_mixlength + logical, intent(in) :: INITIALIZE_QKE +! real(kind_phys), intent(in) :: ust, rmo, pmz, phh, flt, flq + real(kind_phys), intent(in) :: rmo, Psig_bl, xland + real(kind_phys), intent(in) :: dx, ust, zi + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,& &qw,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: el,qke - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: tsq,qsq,cov + real(kind_phys), dimension(kts:kte), intent(inout) :: el,qke + real(kind_phys), dimension(kts:kte) :: & &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv, & &gm,gh,sm,sh,qkw,vt,vq - INTEGER :: k,l,lmax + integer :: k,l,lmax real(kind_phys):: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1., & &flt=0.,fltv=0.,flq=0.,tmpq - real(kind_phys), DIMENSION(kts:kte) :: theta,thetav - real(kind_phys), DIMENSION(kts:kte) :: rstoch_col - INTEGER ::spp_pbl + real(kind_phys), dimension(kts:kte) :: theta,thetav + real(kind_phys), dimension(kts:kte) :: rstoch_col + integer ::spp_pbl !> - At first ql, vt and vq are set to zero. DO k = kts,kte @@ -1706,17 +1709,17 @@ SUBROUTINE mym_level2 (kts,kte, & ! !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v, & + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte), intent(in) :: u,v, & &thl,qw,ql,vt,vq,thetav - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh integer :: k @@ -1844,25 +1847,25 @@ SUBROUTINE mym_length ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq,Psig_bl,xland - real(kind_phys), INTENT(IN) :: dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: u1,v1, & + integer, intent(in) :: bl_mynn_mixlength + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq,Psig_bl,xland + real(kind_phys), intent(in) :: dx,zi + real(kind_phys), dimension(kts:kte), intent(in) :: u1,v1, & &qke,vt,vq,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: qkw, el - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dtv + real(kind_phys), dimension(kts:kte), intent(out) :: qkw, el + real(kind_phys), dimension(kts:kte), intent(in) :: dtv real(kind_phys):: elt,vsc - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: theta - real(kind_phys), DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw + real(kind_phys), dimension(kts:kte), intent(in) :: theta + real(kind_phys), dimension(kts:kte) :: qtke,elBLmin,elBLavg,thetaw real(kind_phys):: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE @@ -1879,22 +1882,22 @@ SUBROUTINE mym_length ( & !THEY ONLY IMPOSE LIMITS ON THE CALCULATION OF THE MIXING LENGTH !SCALES SO THAT THE BOULAC MIXING LENGTH (IN FREE ATMOS) DOES !NOT ENCROACH UPON THE BOUNDARY LAYER MIXING LENGTH (els, elb & elt). - real(kind_phys), PARAMETER :: minzi = 300. !< min mixed-layer height - real(kind_phys), PARAMETER :: maxdz = 750. !< max (half) transition layer depth + real(kind_phys), parameter :: minzi = 300. !< min mixed-layer height + real(kind_phys), parameter :: maxdz = 750. !< max (half) transition layer depth !! =0.3*2500 m PBLH, so the transition !! layer stops growing for PBLHs > 2.5 km. - real(kind_phys), PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth + real(kind_phys), parameter :: mindz = 300. !< 300 !min (half) transition layer depth !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - real(kind_phys), PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - real(kind_phys), PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) + real(kind_phys), parameter :: ZSLH = 100. !< Max height correlated to surface conditions (m) + real(kind_phys), parameter :: CSL = 2. !< CSL = constant of proportionality to L O(1) - INTEGER :: i,j,k + integer :: i,j,k real(kind_phys):: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud, & & wstar,elb,els,elf,el_stab,el_mf,el_stab_mf,elb_mf, & & PBLH_PLUS_ENT,Uonset,Ugrid,wt_u,el_les - real(kind_phys), PARAMETER :: ctau = 1000. !constant for tau_cloud + real(kind_phys), parameter :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -2254,13 +2257,13 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: k,kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), INTENT(OUT) :: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: k,kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), intent(out) :: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: izz, found + integer :: izz, found real(kind_phys):: dlu,dld real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz @@ -2404,15 +2407,15 @@ SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), dimension(kts:kte), intent(out):: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: iz, izz, found - real(kind_phys), DIMENSION(kts:kte) :: dlu,dld - real(kind_phys), PARAMETER :: Lmax=2000. !soft limit + integer :: iz, izz, found + real(kind_phys), dimension(kts:kte) :: dlu,dld + real(kind_phys), parameter :: Lmax=2000. !soft limit real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !print*,"IN MYNN-BouLac",kts, kte @@ -2618,40 +2621,40 @@ SUBROUTINE mym_turbulence ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,tke_budget - real(kind_phys), INTENT(IN) :: closure - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq, & + integer, intent(in) :: bl_mynn_mixlength,tke_budget + real(kind_phys), intent(in) :: closure + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq, & &Psig_bl,Psig_shcu,xland,dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw, & + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,thetav,qw, & &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1, & &TKEprodTD - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq, & + real(kind_phys), dimension(kts:kte), intent(out) :: dfm,dfh,dfq, & &pdk,pdt,pdq,pdc,tcd,qcd,el - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: & + real(kind_phys), dimension(kts:kte), intent(inout) :: & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D real(kind_phys):: q3sq_old,dlsq1,qWTP_old,qWTP_new real(kind_phys):: dudz,dvdz,dTdz,upwp,vpwp,Tpwp - real(kind_phys), DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh + real(kind_phys), dimension(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k + integer :: k ! real(kind_phys):: cc2,cc3,e1c,e2c,e3c,e4c,e5c real(kind_phys):: e6c,dzk,afk,abk,vtt,vqq, & &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh real(kind_phys):: cldavg - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: theta + real(kind_phys), dimension(kts:kte), intent(in) :: theta real(kind_phys):: a2fac, duz, ri !JOE-Canuto/Kitamura mod @@ -2664,10 +2667,10 @@ SUBROUTINE mym_turbulence ( & DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys):: Prnum, shb - real(kind_phys), PARAMETER :: Prlimit = 5.0 + real(kind_phys), parameter :: Prlimit = 5.0 ! ! tv0 = 0.61*tref @@ -3042,7 +3045,8 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & - & TKEprodTD(k) +!fix? & TKEprodTD(k) + & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) pdc(k) = elh*( sh(k)*dtl(k)+gamt ) & @@ -3086,9 +3090,10 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now - qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered +!fix? qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen - !!!Dissipation Term (now it evaluated on mym_predict) + !!!Dissipation Term (now it evaluated in mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE !! >> EOB @@ -3113,8 +3118,6 @@ SUBROUTINE mym_turbulence ( & qcd(k) = ( qcd(k+1)-qcd(k) )/( dzk ) END DO ! - - if (spp_pbl==1) then DO k = kts,kte dfm(k)= dfm(k) + dfm(k)* rstoch_col(k) * 1.5 * MAX(exp(-MAX(zw(k)-8000.,0.0)/2000.),0.001) @@ -3181,43 +3184,43 @@ SUBROUTINE mym_predict (kts,kte, & & delt, & & dz, & & ust, flt, flq, pmz, phh, & - & el, dfq, rho, & + & el, dfq, rho, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & & s_aw,s_awqke,bl_mynn_edmf_tke, & & qWT1D, qDISS1D,tke_budget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke,tke_budget - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - real(kind_phys), INTENT(IN) :: flt, flq, pmz, phh - real(kind_phys), INTENT(IN) :: ust, delt - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov + real(kind_phys), intent(in) :: closure + integer, intent(in) :: bl_mynn_edmf_tke,tke_budget + real(kind_phys), dimension(kts:kte), intent(in) :: dz, dfq, el, rho + real(kind_phys), dimension(kts:kte), intent(inout) :: pdk, pdt, pdq, pdc + real(kind_phys), intent(in) :: flt, flq, pmz, phh + real(kind_phys), intent(in) :: ust, delt + real(kind_phys), dimension(kts:kte), intent(inout) :: qke,tsq, qsq, cov ! WA 8/3/15 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw + real(kind_phys), dimension(kts:kte+1), intent(inout) :: s_awqke,s_aw !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - real(kind_phys), DIMENSION(kts:kte) :: tke_up,dzinv + real(kind_phys), dimension(kts:kte), intent(out) :: qWT1D, qDISS1D + real(kind_phys), dimension(kts:kte) :: tke_up,dzinv !! >> EOB - INTEGER :: k - real(kind_phys), DIMENSION(kts:kte) :: qkw, bp, rp, df3q + integer :: k + real(kind_phys), dimension(kts:kte) :: qkw, bp, rp, df3q real(kind_phys):: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -3263,7 +3266,7 @@ SUBROUTINE mym_predict (kts,kte, & kmdz(k) = MAX(kmdz(k), 0.5* s_aw(k)) kmdz(k) = MAX(kmdz(k), -0.5*(s_aw(k)-s_aw(k+1))) ENDDO -!JOE-end conservation mods + !end conservation mods pdk1 = 2.0*ust**3*pmz/( vkz ) phm = 2.0/ust *phh/( vkz ) @@ -3271,8 +3274,8 @@ SUBROUTINE mym_predict (kts,kte, & pdq1 = phm*flq**2 pdc1 = phm*flt*flq ! -! ** pdk(i,j,1)+pdk(i,j,2) corresponds to pdk1. ** - pdk(kts) = pdk1 -pdk(kts+1) +! ** pdk(1)+pdk(2) corresponds to pdk1. ** + pdk(kts) = pdk1 - pdk(kts+1) !! pdt(kts) = pdt1 -pdt(kts+1) !! pdq(kts) = pdq1 -pdq(kts+1) @@ -3367,7 +3370,7 @@ SUBROUTINE mym_predict (kts,kte, & ENDDO k=kte qWT1D(k)=dzinv(k)*(-kqdz(k)*(tke_up(k)-tke_up(k-1)) & - & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggared + & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggered !! >> EOBvt qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered END IF @@ -3596,39 +3599,42 @@ SUBROUTINE mym_condensation (kts,kte, & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf + integer, intent(in) :: kts,kte, bl_mynn_cloudpdf #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: HFX1,rmo,xland - real(kind_phys), INTENT(IN) :: dx,pblh1 - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw, & + real(kind_phys), intent(in) :: HFX1,rmo,xland + real(kind_phys), intent(in) :: dx,pblh1 + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: p,exner,thl,qw, & &qv,qc,qi,qs,tsq,qsq,cov,th - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm + real(kind_phys), dimension(kts:kte), intent(inout) :: vt,vq,sgm - real(kind_phys), DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: alp,a,bet,b,ql,q1,RH + real(kind_phys), dimension(kts:kte), intent(out) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & - &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & - &qmq,qsat_tk,q1_rh,rh_hack - real(kind_phys), PARAMETER :: rhcrit=0.83 !for hom pdf min sigma - INTEGER :: i,j,k + &ls,wt,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc + real(kind_phys), parameter :: qpct_sfc=0.025 + real(kind_phys), parameter :: qpct_pbl=0.030 + real(kind_phys), parameter :: qpct_trp=0.040 + real(kind_phys), parameter :: rhcrit =0.83 !for hom pdf min sigma + integer :: i,j,k real(kind_phys):: erf !VARIABLES FOR ALTERNATIVE SIGMA real:: dth,dtl,dqw,dzk,els - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: Sh,el + real(kind_phys), dimension(kts:kte), intent(in) :: Sh,el !variables for SGS BL clouds real(kind_phys) :: zagl,damp,PBLH2 @@ -3636,11 +3642,11 @@ SUBROUTINE mym_condensation (kts,kte, & !JAYMES: variables for tropopause-height estimation real(kind_phys) :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo + integer :: k_tropo ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys) :: qw_pert ! First, obtain an estimate for the tropopause height (k), using the method employed in the @@ -3794,29 +3800,31 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - PBLH2=MAX(10.,PBLH1) + pblh2=MAX(10.,pblh1) zagl = 0. + dzm1 = 0. DO k = kts,kte-1 - zagl = zagl + dz(k) - t = th(k)*exner(k) + zagl = zagl + 0.5*(dz(k) + dzm1) + dzm1 = dz(k) - xl = xl_blend(t) ! obtain latent heat - qsat_tk = qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k)=MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) + t = th(k)*exner(k) + xl = xl_blend(t) ! obtain latent heat + qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p + rh(k) = MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) !dqw/dT: Clausius-Clapeyron - dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) + dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) - rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) + rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b(k) = a(k)*rsl ! CB02 variable "b" + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + b(k) = a(k)*rsl ! CB02 variable "b" !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + qw_pert= qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) !This form of qmq (the numerator of Q1) no longer uses the a(k) factor qmq = qw_pert - qsat_tk ! saturation deficit/excess; @@ -3826,14 +3834,24 @@ SUBROUTINE mym_condensation (kts,kte, & r3sq = max( qsq(k), 0.0 ) !Calculate sigma using higher-order moments: sgm(k) = SQRT( r3sq ) - !Set limits on sigma relative to saturation water vapor + !Set constraints on sigma relative to saturation water vapor sgm(k) = min( sgm(k), qsat_tk*0.666 ) - sgm(k) = max( sgm(k), qsat_tk*0.035 ) + !sgm(k) = max( sgm(k), qsat_tk*0.035 ) + + !introduce vertical grid spacing dependence on min sgm + wt = max(500. - max(dz(k)-100.,0.0), 0.0)/500. !=1 for dz < 100 m, =0 for dz > 600 m + sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz + + !allow min sgm to vary with dz and z. + qpct = qpct_pbl*wt + qpct_trp*(1.0-wt) + qpct = min(qpct, max(qpct_sfc, qpct_pbl*zagl/500.) ) + sgm(k) = max( sgm(k), qsat_tk*qpct ) + q1(k) = qmq / sgm(k) ! Q1, the normalized saturation !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc and qi. - rh_hack = rh(k) + rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) @@ -3864,20 +3882,17 @@ SUBROUTINE mym_condensation (kts,kte, & ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. - IF (q1k < 0.) THEN !unsaturated -#ifdef SINGLE_PREC - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#else - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#endif - ql_ice = sgm(k)*EXP(1.2*q1k-1.) - ELSE IF (q1k > 2.) THEN !supersaturated - ql_water = sgm(k)*q1k - ql_ice = sgm(k)*q1k - ELSE !slightly saturated (0 > q1 < 2) - ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF + maxqc = max(qw(k) - qsat_tk, 0.0) + if (q1k < 0.) then !unsaturated + ql_water = sgm(k)*exp(1.2*q1k-1.) + ql_ice = sgm(k)*exp(1.2*q1k-1.) + elseif (q1k > 2.) then !supersaturated + ql_water = min(sgm(k)*q1k, maxqc) + ql_ice = sgm(k)*q1k + else !slightly saturated (0 > q1 < 2) + ql_water = min(sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2), maxqc) + ql_ice = sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2) + endif !In saturated grid cells, use average of SGS and resolved values !if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) @@ -3922,17 +3937,22 @@ SUBROUTINE mym_condensation (kts,kte, & ! Fng = 1.-1.5*q1k !ENDIF ! Use the form of "Fng" from Bechtold and Siebesma (1998, JAS) - IF (q1k .GE. 1.0) THEN + if (q1k .ge. 1.0) then Fng = 1.0 - ELSEIF (q1k .GE. -1.7 .AND. q1k .LT. 1.0) THEN - Fng = EXP(-0.4*(q1k-1.0)) - ELSEIF (q1k .GE. -2.5 .AND. q1k .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(q1k+1.7)) - ELSE - Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) - ENDIF + elseif (q1k .ge. -1.7 .and. q1k .lt. 1.0) then + Fng = exp(-0.4*(q1k-1.0)) + elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then + Fng = 3.0 + exp(-3.8*(q1k+1.7)) + else + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60.) + endif + + cfmax = min(cldfra_bl1D(k), 0.6) + !Further limit the cf going into vt & vq near the surface + zsl = min(max(25., 0.1*pblh2), 100.) + wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer + cfmax = cfmax*wt - cfmax= min(cldfra_bl1D(k), 0.6) bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from ! "b" in CB02 (i.e., b(k) above) by a factor ! of T/theta. Strictly, b(k) above is formulated in @@ -4023,17 +4043,17 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & &bl_mynn_mixscalars ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i + integer, intent(in) :: kts,kte,i #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & + integer, intent(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & + logical, intent(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & &FLAG_QNC,FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA ! thl - liquid water potential temperature @@ -4043,47 +4063,47 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! flq - surface flux of qw ! mass-flux plumes - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: s_aw, & + real(kind_phys), dimension(kts:kte+1), intent(in) :: s_aw, & &s_awthl,s_awqt,s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & &s_awqnwfa,s_awqnifa,s_awqnbca, & &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + real(kind_phys), dimension(kts:kte), intent(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,& + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,th,tk,qv,qc,qi,& &qs,qni,qnc,rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd, & &cldfra_bl1d,diss_heat - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,& + real(kind_phys), dimension(kts:kte), intent(inout) :: thl,sqw,sqv,sqc,& &sqi,sqs,qnwfa,qnifa,qnbca,ozone,dfm,dfh - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv, & + real(kind_phys), dimension(kts:kte), intent(inout) :: du,dv,dth,dqv, & &dqc,dqi,dqs,dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone - real(kind_phys), INTENT(IN) :: flt,flq,flqv,flqc,uoce,voce - real(kind_phys), INTENT(IN) :: ust,delt,psfc,wspd + real(kind_phys), intent(in) :: flt,flq,flqv,flqc,uoce,voce + real(kind_phys), intent(in) :: ust,delt,psfc,wspd !debugging real(kind_phys):: wsp,wsp2,tk2,th2 - LOGICAL :: problem + logical :: problem integer :: kproblem -! real(kind_phys), INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top +! real(kind_phys), intent(in) :: gradu_top,gradv_top,gradth_top,gradqv_top !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - real(kind_phys), DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & + real(kind_phys), dimension(kts:kte) :: dtz,dfhc,dfmc,delp + real(kind_phys), dimension(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & &qni2,qnc2,qnwfa2,qnifa2,qnbca2,ozone2 - real(kind_phys), DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface + real(kind_phys), dimension(kts:kte) :: zfac,plumeKh,rhoinv + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte+1) :: rhoz, & !rho on model interface &khdz,kmdz real(kind_phys):: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw real(kind_phys):: t,esat,qsl,onoff,kh,km,dzk,rhosfc real(kind_phys):: ustdrag,ustdiff,qvflux real(kind_phys):: th_new,portion_qc,portion_qi,condensate,qsat - INTEGER :: k,kk + integer :: k,kk !Activate nonlocal mixing from the mass-flux scheme for !number concentrations and aerosols (0.0 = no; 1.0 = yes) - real(kind_phys), PARAMETER :: nonloc = 1.0 + real(kind_phys), parameter :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -4813,8 +4833,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & d(kte)=qnbca(kte) ! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) + CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !qnbca2(k)=d(k-kts+1) @@ -5207,36 +5227,36 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & enh_mix, smoke_dbg ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: rho - real(kind_phys), INTENT(IN) :: flt - real(kind_phys), INTENT(IN) :: delt,pblh - INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - real(kind_phys), DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - real(kind_phys), DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - real(kind_phys), DIMENSION( ndvel ), INTENT(IN) :: vd1 - real(kind_phys), INTENT(IN) :: emis_ant_no,frp - LOGICAL, INTENT(IN) :: rrfs_sd,enh_mix,smoke_dbg + integer, intent(in) :: kts,kte,i + real(kind_phys), dimension(kts:kte), intent(in) :: dfh,dz,tcd,qcd + real(kind_phys), dimension(kts:kte), intent(inout) :: rho + real(kind_phys), intent(in) :: flt + real(kind_phys), intent(in) :: delt,pblh + integer, intent(in) :: nchem, kdvel, ndvel + real(kind_phys), dimension( kts:kte+1), intent(in) :: s_aw + real(kind_phys), dimension( kts:kte, nchem ), intent(inout) :: chem1 + real(kind_phys), dimension( kts:kte+1,nchem), intent(in) :: s_awchem + real(kind_phys), dimension( ndvel ), intent(in) :: vd1 + real(kind_phys), intent(in) :: emis_ant_no,frp + logical, intent(in) :: rrfs_sd,enh_mix,smoke_dbg !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x real(kind_phys):: rhs,dztop real(kind_phys):: t,dzk real(kind_phys):: hght real(kind_phys):: khdz_old, khdz_back - INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 - INTEGER :: ic ! Chemical array loop index + integer :: k,kk,kmaxfire ! JLS 12/21/21 + integer :: ic ! Chemical array loop index - INTEGER, SAVE :: icall + integer, SAVE :: icall - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,khdz - real(kind_phys), PARAMETER :: NO_threshold = 10.0 ! For anthropogenic sources - real(kind_phys), PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires - real(kind_phys), PARAMETER :: pblh_threshold = 100.0 + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,khdz + real(kind_phys), parameter :: NO_threshold = 10.0 ! For anthropogenic sources + real(kind_phys), parameter :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires + real(kind_phys), parameter :: pblh_threshold = 100.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -5335,14 +5355,14 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& !------------------------------------------------------------------- - INTEGER , INTENT(in) :: kts,kte + integer , intent(in) :: kts,kte - real(kind_phys), DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh + real(kind_phys), dimension(KtS:KtE), intent(in) :: dz,dfm,dfh - real(kind_phys), DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h + real(kind_phys), dimension(KtS:KtE), intent(out) :: K_m, K_h - INTEGER :: k + integer :: k real(kind_phys):: dzk K_m(kts)=0. @@ -5368,13 +5388,13 @@ SUBROUTINE tridiag(n,a,b,c,d) !------------------------------------------------------------------- - INTEGER, INTENT(in):: n - real(kind_phys), DIMENSION(n), INTENT(in) :: a,b - real(kind_phys), DIMENSION(n), INTENT(inout) :: c,d + integer, intent(in):: n + real(kind_phys), dimension(n), intent(in) :: a,b + real(kind_phys), dimension(n), intent(inout) :: c,d - INTEGER :: i + integer :: i real(kind_phys):: p - real(kind_phys), DIMENSION(n) :: q + real(kind_phys), dimension(n) :: q c(n)=0. q(1)=-c(1)/b(1) @@ -5508,23 +5528,23 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) !value could be found to work best in all conditions. !--------------------------------------------------------------- - INTEGER,INTENT(IN) :: KTS,KTE + integer,intent(in) :: KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(OUT) :: zi - real(kind_phys), INTENT(IN) :: landsea - real(kind_phys), DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - real(kind_phys), DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D + real(kind_phys), intent(out) :: zi + real(kind_phys), intent(in) :: landsea + real(kind_phys), dimension(kts:kte), intent(in) :: thetav1D, qke1D, dz1D + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw1D !LOCAL VARS real(kind_phys):: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv real(kind_phys):: delt_thv !delta theta-v; dependent on land/sea point - real(kind_phys), PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - real(kind_phys), PARAMETER :: sbl_damp = 400. !transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi + real(kind_phys), parameter :: sbl_lim = 200. !upper limit of stable BL height (m). + real(kind_phys), parameter :: sbl_damp = 400. !transition length for blending (m). + integer :: I,J,K,kthv,ktke,kzi !Initialize KPBL (kzi) kzi = 2 @@ -5689,12 +5709,12 @@ SUBROUTINE DMP_mf( & & F_QNWFA,F_QNIFA,F_QNBCA, & & Psig_shcu, & ! output info - & nup2,ktop,maxmf,ztop, & + & maxwidth,ktop,maxmf,ztop, & ! inputs for stochastic perturbations & spp_pbl,rstoch_col ) ! inputs: - INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt + integer, intent(in) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt #ifdef HARDCODE_VERTICAL # define kts 1 @@ -5702,133 +5722,137 @@ SUBROUTINE DMP_mf( & #endif ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: & + real(kind_phys),dimension(kts:kte), intent(in) :: & &U,V,W,TH,THL,TK,QT,QV,QC, & &exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: zw !height at full-sigma - real(kind_phys), INTENT(IN) :: flt,fltv,flq,flqv,Psig_shcu, & + real(kind_phys),dimension(kts:kte+1), intent(in) :: zw !height at full-sigma + real(kind_phys), intent(in) :: flt,fltv,flq,flqv,Psig_shcu, & &landsea,ts,dx,dt,ust,pblh - LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA + logical, optional :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA ! outputs - updraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & + real(kind_phys),dimension(kts:kte), intent(out) :: edmf_a,edmf_w, & & edmf_qt,edmf_thl,edmf_ent,edmf_qc !add one local edmf variable: - real(kind_phys),DIMENSION(KTS:KTE) :: edmf_th + real(kind_phys),dimension(kts:kte) :: edmf_th ! output - INTEGER, INTENT(OUT) :: nup2,ktop - real(kind_phys), INTENT(OUT) :: maxmf - real(kind_phys), INTENT(OUT) :: ztop + integer, intent(out) :: ktop + real(kind_phys), intent(out) :: maxmf,ztop,maxwidth ! outputs - variables needed for solver - real(kind_phys),DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi + real(kind_phys),dimension(kts:kte+1) :: s_aw, & !sum ai*rho*wis_awphi &s_awthl,s_awqt,s_awqv,s_awqc,s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa,s_awqnbca,s_awu,s_awv, & &s_awqke,s_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: & + real(kind_phys),dimension(kts:kte), intent(inout) :: & &qc_bl1d,cldfra_bl1d,qc_bl1d_old,cldfra_bl1d_old - INTEGER, PARAMETER :: nup=10, debug_mf=0 + integer, parameter :: nup=8, debug_mf=0 + real(kind_phys) :: nup2 !------------- local variables ------------------- ! updraft properties defined on interfaces (k=1 is the top of the ! first model layer - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP) :: & + real(kind_phys),dimension(kts:kte+1,1:NUP) :: & &UPW,UPTHL,UPQT,UPQC,UPQV, & &UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & &UPQNI,UPQNWFA,UPQNIFA,UPQNBCA ! entrainment variables - real(kind_phys),DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi + real(kind_phys),dimension(kts:kte,1:NUP) :: ENT,ENTf + integer,dimension(kts:kte,1:NUP) :: ENTi ! internal variables - INTEGER :: K,I,k50 + integer :: K,I,k50 real(kind_phys):: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT, & &sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & - QNWFAn,QNIFAn,QNBCAn, & - Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int + & QNWFAn,QNIFAn,QNBCAn, & + & Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int ! w parameters - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &Wa=2./3., & &Wb=0.002, & &Wc=1.5 ! Lateral entrainment parameters ( L0=100 and ENT0=0.1) were taken from ! Suselj et al (2013, jas). Note that Suselj et al (2014,waf) use L0=200 and ENT0=0.2. - real(kind_phys),PARAMETER :: & - & L0=100., & - & ENT0=0.1 - - ! Implement ideas from Neggers (2016, JAMES): - real(kind_phys), PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - real(kind_phys), PARAMETER :: lmax = 1000.! diameter of largest plume - real(kind_phys), PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - real(kind_phys), PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). + real(kind_phys),parameter :: & + & L0=100., & + & ENT0=0.1 + + ! Parameters/variables for regulating plumes: + real(kind_phys), parameter :: Atot = 0.10 ! Maximum total fractional area of all updrafts + real(kind_phys), parameter :: lmax = 1000.! diameter of largest plume (absolute maximum, can be smaller) + real(kind_phys), parameter :: lmin = 300. ! diameter of smallest plume (absolute minimum, can be larger) + real(kind_phys), parameter :: dlmin = 0. ! delta increase in the diameter of smallest plume (large fltv) + real(kind_phys) :: minwidth ! actual width of smallest plume + real(kind_phys) :: dl ! variable increment of plume size + real(kind_phys), parameter :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) + real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). ! Note that changing d to -2.0 makes each size plume equally contribute to the total coverage of all plumes. ! Note that changing d to -1.7 doubles the area coverage of the largest plumes relative to the smallest plumes. - real(kind_phys):: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx + real(kind_phys):: cn,c,l,n,an2,hux,wspd_pbl,cloud_base,width_flx ! chem/smoke - INTEGER, INTENT(IN) :: nchem - real(kind_phys),DIMENSION(:, :) :: chem1 - real(kind_phys),DIMENSION(kts:kte+1, nchem) :: s_awchem - real(kind_phys),DIMENSION(nchem) :: chemn - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM - INTEGER :: ic - real(kind_phys),DIMENSION(KTS:KTE+1, nchem) :: edmf_chem - LOGICAL, INTENT(IN) :: mix_chem + integer, intent(in) :: nchem + real(kind_phys),dimension(:, :) :: chem1 + real(kind_phys),dimension(kts:kte+1, nchem) :: s_awchem + real(kind_phys),dimension(nchem) :: chemn + real(kind_phys),dimension(kts:kte+1,1:NUP, nchem) :: UPCHEM + integer :: ic + real(kind_phys),dimension(kts:kte+1, nchem) :: edmf_chem + logical, intent(in) :: mix_chem !JOE: add declaration of ERF real(kind_phys):: ERF - LOGICAL :: superadiabatic + logical :: superadiabatic ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm + real(kind_phys),dimension(kts:kte), intent(inout) :: vt, vq, sgm real(kind_phys):: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & Ac_mf,Ac_strat,qc_mf - real(kind_phys), PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value + real(kind_phys), parameter :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value ! Variables for plume interpolation/saturation check - real(kind_phys),DIMENSION(KTS:KTE) :: exneri,dzi + real(kind_phys),dimension(kts:kte) :: exneri,dzi,rhoz real(kind_phys):: THp, QTp, QCp, QCs, esat, qsl - real(kind_phys):: csigma,acfac,ac_wsp,ac_cld + real(kind_phys):: csigma,acfac,ac_wsp !plume overshoot - INTEGER :: overshoot + integer :: overshoot real(kind_phys):: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. real(kind_phys):: adjustment, flx1 - real(kind_phys), PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact + real(kind_phys), parameter :: fluxportion=0.75 ! set liberally, so has minimal impact. Note that + ! 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. !Subsidence - real(kind_phys),DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + real(kind_phys),dimension(kts:kte) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & envm_u,envm_v !environmental variables defined at middle of layer - real(kind_phys),DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface + real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & qc_plume,exc_heat,exc_moist,tk_int - real(kind_phys), PARAMETER :: Cdet = 1./45. - real(kind_phys), PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers + real(kind_phys), parameter :: Cdet = 1./45. + real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme !is compensated by "gentle" environmental subsidence. - real(kind_phys), PARAMETER :: Csub=0.25 + real(kind_phys), parameter :: Csub=0.25 !Factor for the pressure gradient effects on momentum transport - real(kind_phys), PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + real(kind_phys), parameter :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere real(kind_phys):: Uk,Ukm1,Vk,Vkm1,dxsa ! check the inputs @@ -5859,9 +5883,9 @@ SUBROUTINE DMP_mf( & UPQNWFA=0. UPQNIFA=0. UPQNBCA=0. - IF ( mix_chem ) THEN - UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 - ENDIF + if ( mix_chem ) then + UPCHEM(kts:kte+1,1:NUP,1:nchem)=0.0 + endif ENT=0.001 ! Initialize mean updraft properties @@ -5871,9 +5895,9 @@ SUBROUTINE DMP_mf( & edmf_thl=0. edmf_ent=0. edmf_qc =0. - IF ( mix_chem ) THEN + if ( mix_chem ) then edmf_chem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize the variables needed for implicit solver s_aw=0. @@ -5889,153 +5913,161 @@ SUBROUTINE DMP_mf( & s_awqnwfa=0. s_awqnifa=0. s_awqnbca=0. - IF ( mix_chem ) THEN + if ( mix_chem ) then s_awchem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize explicit tendencies for subsidence & detrainment sub_thl = 0. sub_sqv = 0. - sub_u = 0. - sub_v = 0. + sub_u = 0. + sub_v = 0. det_thl = 0. det_sqv = 0. det_sqc = 0. - det_u = 0. - det_v = 0. + det_u = 0. + det_v = 0. + nup2 = nup !start with nup, but set to zero if activation criteria fails ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... - k = 1 - maxw = 0.0 + maxw = 0.0 cloud_base = 9000.0 -! DO WHILE (ZW(k) < pblh + 500.) - DO k=1,kte-1 - IF(zw(k) > pblh + 500.) exit + do k=1,kte-1 + if (zw(k) > pblh + 500.) exit wpbl = w(k) - IF(w(k) < 0.)wpbl = 2.*w(k) - maxw = MAX(maxw,ABS(wpbl)) + if (w(k) < 0.)wpbl = 2.*w(k) + maxw = max(maxw,abs(wpbl)) !Find highest k-level below 50m AGL - IF(ZW(k)<=50.)k50=k + if (ZW(k)<=50.)k50=k !Search for cloud base - qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) - IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN + qc_sgs = max(qc(k), qc_bl1d(k)) + if (qc_sgs> 1E-5 .and. (cldfra_bl1d(k) .ge. 0.5) .and. cloud_base == 9000.0) then cloud_base = 0.5*(ZW(k)+ZW(k+1)) - ENDIF + endif + enddo - !k = k + 1 - ENDDO - !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but - Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s - Psig_w = MIN(Psig_w, Psig_shcu) - !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu + !do nothing for small w (< 1 m/s), but linearly taper off for w > 1.0 m/s + maxw = max(0.,maxw - 1.0) + Psig_w = max(0.0, 1.0 - maxw) + Psig_w = min(Psig_w, Psig_shcu) !Completely shut off MF scheme for strong resolved-scale vertical velocities. fltv2 = fltv - IF(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv + if(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv ! If surface buoyancy is positive we do integration, otherwise no. ! Also, ensure that it is at least slightly superadiabatic up through 50 m superadiabatic = .false. - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5).ge.0) then hux = -0.001 ! WATER ! dT/dz must be < - 0.1 K per 100 m. - ELSE + else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. - ENDIF - DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). - IF (k == 1) then - IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN + endif + do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). + if (k == 1) then + if ((th(k)-ts)/(0.5*dz(k)) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ELSE - IF ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) THEN + endif + else + if ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ENDIF - ENDDO + endif + endif + enddo ! Determine the numer of updrafts/plumes in the grid column: ! Some of these criteria may be a little redundant but useful for bullet-proofing. - ! (1) largest plume = 1.0 * dx. - ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. + ! (1) largest plume = 1.2 * dx. + ! (2) Apply a scale-break, assuming no plumes with diameter larger than 1.1*PBLH can exist. ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) limit to reduce max plume sizes in weakly forced conditions. This is only ! meant to "soften" the activation of the mass-flux scheme. ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) + maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = 1.1*PBLH + maxwidth = min(maxwidth, 1.1*PBLH) ! Criteria (3) - maxwidth = MIN(maxwidth,0.5*cloud_base) + if ((landsea-1.5) .lt. 0) then !land + maxwidth = MIN(maxwidth, 0.5*cloud_base) + else !water + maxwidth = MIN(maxwidth, 0.9*cloud_base) + endif ! Criteria (4) wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000.), 0.) else !water - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000.), 0.) + endif + maxwidth = MIN(maxwidth, width_flx) + minwidth = lmin + !allow min plume size to increase in large flux conditions (eddy diffusivity should be + !large enough to handle the representation of small plumes). + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1.) + + if (maxwidth .le. minwidth) then ! deactivate MF component + nup2 = 0 + maxwidth = 0.0 endif - maxwidth = MIN(maxwidth,width_flx) - ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) - !Initialize values for 2d output fields: - ktop = 0 - ztop = 0.0 - maxmf= 0.0 + ! Initialize values for 2d output fields: + ktop = 0 + ztop = 0.0 + maxmf= 0.0 - IF ( fltv2 > 0.002 .AND. NUP2 .GE. 1 .AND. superadiabatic) then - !PRINT*," Conditions met to run mass-flux scheme",fltv2,pblh +!Begin plume processing if passes criteria +if ( fltv2 > 0.002 .AND. (maxwidth > minwidth) .AND. superadiabatic) then ! Find coef C for number size density N cn = 0. - d=-1.9 !set d to value suggested by Neggers 2015 (JAMES). - !d=-1.9 + .2*tanh((fltv2 - 0.05)/0.15) - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). + dl = (maxwidth - minwidth)/real(nup-1) + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) cn = cn + l**d * (l*l)/(dx*dx) * dl ! sum fractional area of each plume enddo C = Atot/cn !Normalize C according to the defined total fraction (Atot) ! Make updraft area (UPA) a function of the buoyancy flux if ((landsea-1.5).LT.0) then !land - !acfac = .5*tanh((fltv2 - 0.03)/0.09) + .5 - !acfac = .5*tanh((fltv2 - 0.02)/0.09) + .5 acfac = .5*tanh((fltv2 - 0.02)/0.05) + .5 else !water acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: - ac_wsp = 1.0 - min(max(wspd_pbl - 20.0, 0.0), 10.0)/10.0 - !reduce area fraction beneath cloud bases < 1200 m AGL - ac_cld = min(cloud_base/1200., 1.0) - acfac = acfac * min(ac_wsp, ac_cld) + !the mass-flux scheme linearly above sfc wind speeds of 15 m/s. + !Note: this effect may be better represented by an increase in + !entrainment rate for high wind consitions (more ambient turbulence). + ac_wsp = 1.0 - min(max(wspd_pbl - 15.0, 0.0), 10.0)/10.0 + acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: An2 = 0. - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) N = C*l**d ! number density of plume n - UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n + UPA(1,i) = N*l*l/(dx*dx) * dl ! fractional area of plume n - UPA(1,I) = UPA(1,I)*acfac - An2 = An2 + UPA(1,I) ! total fractional area of all plumes + UPA(1,i) = UPA(1,i)*acfac + An2 = An2 + UPA(1,i) ! total fractional area of all plumes !print*," plume size=",l,"; area=",UPA(1,I),"; total=",An2 end do @@ -6048,11 +6080,11 @@ SUBROUTINE DMP_mf( & qstar=max(flq,1.0E-5)/wstar thstar=flt/wstar - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5) .ge. 0) then csigma = 1.34 ! WATER - ELSE + else csigma = 1.34 ! LAND - ENDIF + endif if (env_subs) then exc_fac = 0.0 @@ -6065,6 +6097,8 @@ SUBROUTINE DMP_mf( & exc_fac = 0.58 endif endif + !decrease excess for large wind speeds + exc_fac = exc_fac * ac_wsp !Note: sigmaW is typically about 0.5*wstar sigmaW =csigma*wstar*(z0/pblh)**(onethird)*(1 - 0.8*z0/pblh) @@ -6077,14 +6111,11 @@ SUBROUTINE DMP_mf( & wmax=MIN(sigmaW*pwmax,0.5) !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP wlv=wmin+(wmax-wmin)/NUP2*(i-1) !SURFACE UPDRAFT VERTICAL VELOCITY UPW(1,I)=wmin + real(i)/real(NUP)*(wmax-wmin) - !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0.0 @@ -6093,21 +6124,11 @@ SUBROUTINE DMP_mf( & exc_heat = exc_fac*UPW(1,I)*sigmaTH/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat -!was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat !calculate exc_moist by use of surface fluxes exc_moist=exc_fac*UPW(1,I)*sigmaQT/sigmaW - !calculate exc_moist by conserving rh: -! tk_int =(tk(kts)*dz(kts+1)+tk(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! pk =(p(kts)*dz(kts+1)+p(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! qtk =(qt(kts)*dz(kts+1)+qt(kts+1)*dz(kts))/(dz(kts)+dz(kts+1)) -! qsat_tk = qsat_blend(tk_int, pk) ! saturation water vapor mixing ratio at tk and p -! rhgrid =MAX(MIN(1.0,qtk/MAX(1.E-8,qsat_tk)),0.001) -! tk_int = tk_int + exc_heat -! qsat_tk = qsat_blend(tk_int, pk) -! exc_moist= max(rhgrid*qsat_tk - qtk, 0.0) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& & +exc_moist @@ -6117,36 +6138,36 @@ SUBROUTINE DMP_mf( & UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNBCA(1,I)=(QNBCA(KTS)*DZ(KTS+1)+QNBCA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - ENDDO + enddo - IF ( mix_chem ) THEN - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if ( mix_chem ) then + do i=1,NUP do ic = 1,nchem - UPCHEM(1,I,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + UPCHEM(1,i,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) enddo - ENDDO - ENDIF + enddo + endif !Initialize environmental variables which can be modified by detrainment - DO k=kts,kte - envm_thl(k)=THL(k) - envm_sqv(k)=QV(k) - envm_sqc(k)=QC(k) - envm_u(k)=U(k) - envm_v(k)=V(k) - ENDDO + envm_thl(kts:kte)=THL(kts:kte) + envm_sqv(kts:kte)=QV(kts:kte) + envm_sqc(kts:kte)=QC(kts:kte) + envm_u(kts:kte)=U(kts:kte) + envm_v(kts:kte)=V(kts:kte) + do k=kts,kte-1 + rhoz(k) = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) + enddo + rhoz(kte) = rho(kte) !dxsa is scale-adaptive factor governing the pressure-gradient term of the momentum transport dxsa = 1. - MIN(MAX((12000.0-dx)/(12000.0-3000.0), 0.), 1.) ! do integration updraft - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP QCn = 0. overshoot = 0 - l = dl*I ! diameter of plume - DO k=KTS+1,KTE-1 + l = minwidth + dl*real(i-1) ! diameter of plume + do k=kts+1,kte-1 !Entrainment from Tian and Kuang (2016) !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh @@ -6161,7 +6182,7 @@ SUBROUTINE DMP_mf( & ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang - !JOE - increase entrainment for plumes extending very high. + !increase entrainment for plumes extending very high. IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF @@ -6339,6 +6360,7 @@ SUBROUTINE DMP_mf( & exit !exit k-loop END IF ENDDO + IF (debug_mf == 1) THEN IF (MAXVAL(UPW(:,I)) > 10.0 .OR. MINVAL(UPA(:,I)) < 0.0 .OR. & MAXVAL(UPA(:,I)) > Atot .OR. NUP2 > 10) THEN @@ -6358,30 +6380,26 @@ SUBROUTINE DMP_mf( & ENDIF ENDIF ENDDO - ELSE +ELSE !At least one of the conditions was not met for activating the MF scheme. NUP2=0. - END IF !end criteria for mass-flux scheme +END IF !end criteria check for mass-flux scheme - ktop=MIN(ktop,KTE-1) ! Just to be safe... - IF (ktop == 0) THEN - ztop = 0.0 - ELSE - ztop=zw(ktop) - ENDIF - - IF(nup2 > 0) THEN +ktop=MIN(ktop,KTE-1) +IF (ktop == 0) THEN + ztop = 0.0 +ELSE + ztop=zw(ktop) +ENDIF - !Calculate the fluxes for each variable - !All s_aw* variable are == 0 at k=1 - DO i=1,NUP !NUP2 - IF(I > NUP2) exit +IF (nup2 > 0) THEN + !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 + DO i=1,NUP DO k=KTS,KTE-1 - IF(k > ktop) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - s_aw(k+1) = s_aw(k+1) + rho_int*UPA(K,i)*UPW(K,i)*Psig_w - s_awthl(k+1)= s_awthl(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w - s_awqt(k+1) = s_awqt(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w + s_aw(k+1) = s_aw(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*Psig_w + s_awthl(k+1)= s_awthl(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w + s_awqt(k+1) = s_awqt(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w !to conform to grid mean properties, move qc to qv in grid mean !saturated layers, so total water fluxes are preserved but !negative qc fluxes in unsaturated layers is reduced. @@ -6390,72 +6408,76 @@ SUBROUTINE DMP_mf( & ! else ! qc_plume = 0.0 ! endif - s_awqc(k+1) = s_awqc(k+1) + rho_int*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w - IF (momentum_opt > 0) THEN - s_awu(k+1) = s_awu(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w - s_awv(k+1) = s_awv(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w - ENDIF - IF (tke_opt > 0) THEN - s_awqke(k+1)= s_awqke(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w - ENDIF + s_awqc(k+1) = s_awqc(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) ENDDO - ENDDO - - IF ( mix_chem ) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO i=1,NUP !NUP2 - IF(I > NUP2) exit - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + rho_int*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo - ENDDO - ENDDO - ENDIF - - IF (scalar_opt > 0) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF (I > NUP2) exit - s_awqnc(k+1)= s_awqnc(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w - s_awqni(k+1)= s_awqni(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w - s_awqnwfa(k+1)= s_awqnwfa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w - s_awqnifa(k+1)= s_awqnifa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w - s_awqnbca(k+1)= s_awqnbca(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w - ENDDO - ENDDO - ENDIF + ENDDO + !momentum + if (momentum_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awu(k+1) = s_awu(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w + s_awv(k+1) = s_awv(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w + enddo + enddo + endif + !tke + if (tke_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awqke(k+1)= s_awqke(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w + enddo + enddo + endif + !chem + if ( mix_chem ) then + do k=kts,kte + do i=1,nup + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + enddo + enddo + endif + + if (scalar_opt > 0) then + do k=kts,kte + do I=1,nup + s_awqnc(k+1) = s_awqnc(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w + s_awqni(k+1) = s_awqni(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w + s_awqnwfa(k+1)= s_awqnwfa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w + s_awqnifa(k+1)= s_awqnifa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w + s_awqnbca(k+1)= s_awqnbca(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w + enddo + enddo + endif - !Flux limiter: Check ratio of heat flux at top of first model layer - !and at the surface. Make sure estimated flux out of the top of the - !layer is < fluxportion*surface_heat_flux - IF (s_aw(kts+1) /= 0.) THEN + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux + IF (s_aw(kts+1) /= 0.) THEN dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) - ELSE + ELSE flx1 = 0.0 !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& ! " superadiabatic=",superadiabatic," KTOP=",KTOP - ENDIF - adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 - !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) - IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + ENDIF + adjustment=1.0 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN adjustment= fluxportion*flt/dz(kts)/flx1 - s_aw = s_aw*adjustment - s_awthl= s_awthl*adjustment - s_awqt = s_awqt*adjustment - s_awqc = s_awqc*adjustment - s_awqv = s_awqv*adjustment - s_awqnc= s_awqnc*adjustment - s_awqni= s_awqni*adjustment - s_awqnwfa= s_awqnwfa*adjustment - s_awqnifa= s_awqnifa*adjustment - s_awqnbca= s_awqnbca*adjustment + s_aw = s_aw*adjustment + s_awthl = s_awthl*adjustment + s_awqt = s_awqt*adjustment + s_awqc = s_awqc*adjustment + s_awqv = s_awqv*adjustment + s_awqnc = s_awqnc*adjustment + s_awqni = s_awqni*adjustment + s_awqnwfa = s_awqnwfa*adjustment + s_awqnifa = s_awqnifa*adjustment + s_awqnbca = s_awqnbca*adjustment IF (momentum_opt > 0) THEN s_awu = s_awu*adjustment s_awv = s_awv*adjustment @@ -6467,62 +6489,57 @@ SUBROUTINE DMP_mf( & s_awchem = s_awchem*adjustment ENDIF UPA = UPA*adjustment - ENDIF - !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt - - !Calculate mean updraft properties for output: - !all edmf_* variables at k=1 correspond to the interface at top of first model layer - DO k=KTS,KTE-1 - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - edmf_a(K) =edmf_a(K) +UPA(K,i) - edmf_w(K) =edmf_w(K) +rho_int*UPA(K,i)*UPW(K,i) - edmf_qt(K) =edmf_qt(K) +rho_int*UPA(K,i)*UPQT(K,i) - edmf_thl(K)=edmf_thl(K)+rho_int*UPA(K,i)*UPTHL(K,i) - edmf_ent(K)=edmf_ent(K)+rho_int*UPA(K,i)*ENT(K,i) - edmf_qc(K) =edmf_qc(K) +rho_int*UPA(K,i)*UPQC(K,i) - ENDDO - + ENDIF + !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt + + !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer + do k=kts,kte-1 + do I=1,nup + edmf_a(K) =edmf_a(K) +UPA(K,i) + edmf_w(K) =edmf_w(K) +rhoz(k)*UPA(K,i)*UPW(K,i) + edmf_qt(K) =edmf_qt(K) +rhoz(k)*UPA(K,i)*UPQT(K,i) + edmf_thl(K)=edmf_thl(K)+rhoz(k)*UPA(K,i)*UPTHL(K,i) + edmf_ent(K)=edmf_ent(K)+rhoz(k)*UPA(K,i)*ENT(K,i) + edmf_qc(K) =edmf_qc(K) +rhoz(k)*UPA(K,i)*UPQC(K,i) + enddo + enddo + do k=kts,kte-1 !Note that only edmf_a is multiplied by Psig_w. This takes care of the !scale-awareness of the subsidence below: - IF (edmf_a(k)>0.) THEN - edmf_w(k)=edmf_w(k)/edmf_a(k) - edmf_qt(k)=edmf_qt(k)/edmf_a(k) - edmf_thl(k)=edmf_thl(k)/edmf_a(k) - edmf_ent(k)=edmf_ent(k)/edmf_a(k) - edmf_qc(k)=edmf_qc(k)/edmf_a(k) - edmf_a(k)=edmf_a(k)*Psig_w - - !FIND MAXIMUM MASS-FLUX IN THE COLUMN: - IF(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) - ENDIF - ENDDO ! end k - - !smoke/chem - IF ( mix_chem ) THEN - DO k=kts,kte-1 - IF(k > KTOP) exit - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if (edmf_a(k)>0.) then + edmf_w(k)=edmf_w(k)/edmf_a(k) + edmf_qt(k)=edmf_qt(k)/edmf_a(k) + edmf_thl(k)=edmf_thl(k)/edmf_a(k) + edmf_ent(k)=edmf_ent(k)/edmf_a(k) + edmf_qc(k)=edmf_qc(k)/edmf_a(k) + edmf_a(k)=edmf_a(k)*Psig_w + !FIND MAXIMUM MASS-FLUX IN THE COLUMN: + if(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) + endif + enddo ! end k + + !smoke/chem + if ( mix_chem ) then + do k=kts,kte-1 + do I=1,nup do ic = 1,nchem - edmf_chem(k,ic) = edmf_chem(k,ic) + rho_int*UPA(K,I)*UPCHEM(k,i,ic) + edmf_chem(k,ic) = edmf_chem(k,ic) + rhoz(k)*UPA(K,I)*UPCHEM(k,i,ic) enddo - ENDDO - - IF (edmf_a(k)>0.) THEN + enddo + enddo + do k=kts,kte-1 + if (edmf_a(k)>0.) then do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic)/edmf_a(k) enddo - ENDIF - ENDDO ! end k - ENDIF + endif + enddo ! end k + endif - !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables - IF (env_subs) THEN + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN DO k=kts+1,kte-1 !First, smooth the profiles of w & a, since sharp vertical gradients !in plume variables are not likely extended to env variables @@ -6557,18 +6574,16 @@ SUBROUTINE DMP_mf( & !calculate tendencies from subsidence and detrainment valid at the middle of !each model layer. The lowest model layer uses an assumes w=0 at the surface. dzi(kts) = 0.5*(dz(kts)+dz(kts+1)) - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_thl(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rho_int + (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rhoz(k) sub_sqv(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rho_int + (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 dzi(k) = 0.5*(dz(k)+dz(k+1)) - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_thl(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rho_int + (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rhoz(k) sub_sqv(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rho_int + (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6578,17 +6593,15 @@ SUBROUTINE DMP_mf( & ENDDO IF (momentum_opt > 0) THEN - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rho_int + (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rhoz(k) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rho_int + (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rho_int + (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rhoz(k) sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rho_int + (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6596,23 +6609,23 @@ SUBROUTINE DMP_mf( & det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w ENDDO ENDIF - ENDIF !end subsidence/env detranment + ENDIF !end subsidence/env detranment - !First, compute exner, plume theta, and dz centered at interface - !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). - DO K=KTS,KTE-1 - exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + !First, compute exner, plume theta, and dz centered at interface + !Here, k=1 is the top of the first model layer. These values do not + !need to be defined at k=kte (unused level). + DO K=KTS,KTE-1 + exneri(k) = (exner(k)*dz(k+1)+exner(k+1)*dz(k))/(dz(k+1)+dz(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - ENDDO + dzi(k) = 0.5*(dz(k)+dz(k+1)) + ENDDO !JOE: ADD CLDFRA_bl1d, qc_bl1d. Note that they have already been defined in ! mym_condensation. Here, a shallow-cu component is added, but no cumulus ! clouds can be added at k=1 (start loop at k=2). - do k=kts+1,kte-2 - IF(k > KTOP) exit - IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN + do k=kts+1,kte-2 + if (k > KTOP) exit + if(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN !interpolate plume quantities to mass levels Aup = (edmf_a(k)*dzi(k-1)+edmf_a(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) @@ -6686,8 +6699,8 @@ SUBROUTINE DMP_mf( & !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) !Original CB mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) - mf_cf = max(mf_cf, 1.75 * Aup) - mf_cf = min(mf_cf, 5.0 * Aup) + mf_cf = max(mf_cf, 1.8 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) endif !IF ( debug_code ) THEN @@ -6705,10 +6718,7 @@ SUBROUTINE DMP_mf( & if (QCp * Aup > 5e-5) then qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 else - qc_bl1d(k) = 1.18 * (QCp * Aup) - endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf + qc_bl1d(k) = 1.18 * (QCp * Aup) endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf @@ -6718,9 +6728,6 @@ SUBROUTINE DMP_mf( & else qc_bl1d(k) = 1.18 * (QCp * Aup) endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf endif @@ -6752,13 +6759,13 @@ SUBROUTINE DMP_mf( & endif !check for (qc in plume) .and. (cldfra_bl < threshold) enddo !k-loop - ENDIF !end nup2 > 0 +ENDIF !end nup2 > 0 - !modify output (negative: dry plume, positive: moist plume) - if (ktop > 0) then - maxqc = maxval(edmf_qc(1:ktop)) - if ( maxqc < 1.E-8) maxmf = -1.0*maxmf - endif +!modify output (negative: dry plume, positive: moist plume) +if (ktop > 0) then + maxqc = maxval(edmf_qc(1:ktop)) + if ( maxqc < 1.E-8) maxmf = -1.0*maxmf +endif ! ! debugging @@ -6927,62 +6934,68 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & &qc_bl1d,cldfra_bl1d, & &rthraten ) - INTEGER, INTENT(IN) :: KTS,KTE,KPBL - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& - THV,P,rho,exner,dz - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: rthraten + integer, intent(in) :: KTS,KTE,KPBL + real(kind_phys), dimension(kts:kte), intent(in) :: & + U,V,TH,THL,TK,QT,QV,QC,THV,P,rho,exner,dz + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten ! zw .. heights of the downdraft levels (edges of boxes) - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW - real(kind_phys), INTENT(IN) :: WTHL,WQT - real(kind_phys), INTENT(IN) :: dt,ust,pblh + real(kind_phys), dimension(kts:kte+1), intent(in) :: ZW + real(kind_phys), intent(in) :: WTHL,WQT + real(kind_phys), intent(in) :: dt,ust,pblh ! outputs - downdraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & - & edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd + real(kind_phys), dimension(kts:kte), intent(out) :: & + edmf_a_dd,edmf_w_dd, & + edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd ! outputs - variables needed for solver (sd_aw - sum ai*wi, sd_awphi - sum ai*wi*phii) - real(kind_phys),DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & - sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 + real(kind_phys), dimension(kts:kte+1) :: & + sd_aw, sd_awthl, sd_awqt, sd_awu, & + sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d + real(kind_phys), dimension(kts:kte), intent(in) :: & + qc_bl1d, cldfra_bl1d - INTEGER, PARAMETER :: NDOWN=5, debug_mf=0 !fixing number of plumes to 5 + integer, parameter:: ndown = 5 ! draw downdraft starting height randomly between cloud base and cloud top - INTEGER, DIMENSION(1:NDOWN) :: DD_initK - real(kind_phys) , DIMENSION(1:NDOWN) :: randNum + integer, dimension(1:NDOWN) :: DD_initK + real(kind_phys), dimension(1:NDOWN) :: randNum ! downdraft properties - real(kind_phys),DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& - DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV + real(kind_phys), dimension(kts:kte+1,1:NDOWN) :: & + DOWNW,DOWNTHL,DOWNQT,DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV ! entrainment variables - Real(Kind_phys),DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf - INTEGER,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENTi + real(kind_phys), dimension(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf + integer, dimension(KTS+1:KTE+1,1:NDOWN) :: ENTi ! internal variables - INTEGER :: K,I,ki, kminrad, qlTop, p700_ind, qlBase - real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw - real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & - EntEXP,EntW, Beta_dm, EntExp_M, rho_int - real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & + integer :: K,I,ki, kminrad, qlTop, p700_ind, qlBase + real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT, & + sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn, & + THVk,Pk,EntEXP,EntW,beta_dm,EntExp_M,rho_int + real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & refTHL, refTHV, refQT ! DD specific internal variables real(kind_phys):: minrad,zminrad, radflux, F0, wst_rad, wst_dd logical :: cloudflg - - real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& + real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt, & Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid ! w parameters - real(kind_phys),PARAMETER :: & - &Wa=1., & - &Wb=1.5,& - &Z00=100.,& - &BCOEFF=0.2 + real(kind_phys),parameter :: & + &Wa=1., Wb=1.5, Z00=100., BCOEFF=0.2 ! entrainment parameters - real(kind_phys),PARAMETER :: & - & L0=80,& - & ENT0=0.2 - + real(kind_phys),parameter :: & + &L0=80, ENT0=0.2 + !downdraft properties + real(kind_phys):: & + & dp, & !diameter of plume + & dl, & !diameter increment + & Adn !total area of downdrafts + !additional printouts for debugging + integer, parameter :: debug_mf=0 + + dl = (1000.-500.)/real(ndown) pwmin=-3. ! drawing from the negative tail -3sigma to -1sigma pwmax=-1. @@ -7052,6 +7065,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & if ( radflux < 0.0 ) F0 = abs(radflux) + F0 enddo F0 = max(F0, 1.0) + + !Allow the total fractional area of the downdrafts to be proportional + !to the radiative forcing: + !for 50 W/m2, Adn = 0.10 + !for 100 W/m2, Adn = 0.15 + !for 150 W/m2, Adn = 0.20 + Adn = min( 0.05 + F0*0.001, 0.3) + !found Sc cloud and cloud not at surface, trigger downdraft if (cloudflg) then @@ -7066,14 +7087,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! call Poisson(1,NDOWN,kts+1,kte,ENTf,ENTi) - ! entrainent: Ent=Ent0/dz*P(dz/L0) - do i=1,NDOWN - do k=kts+1,kte -! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) - ENT(k,i) = 0.002 - ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) - enddo - enddo +! ! entrainent: Ent=Ent0/dz*P(dz/L0) +! do i=1,NDOWN +! do k=kts+1,kte +!! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) +! ENT(k,i) = 0.002 +! ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) +! enddo +! enddo !!![EW: INVJUMP] find 700mb height then subtract trpospheric lapse rate!!! p700_ind = MINLOC(ABS(p-70000),1)!p1D is 70000 @@ -7116,8 +7137,10 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & !DOWNW(ki,I)=0.5*(wlv+wtv) DOWNW(ki,I)=wlv + !multiply downa by cloud fraction, so it's impact will diminish if + !clouds are mixed away over the course of the longer radiation time step !DOWNA(ki,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - DOWNA(ki,I)=.1/real(NDOWN) + DOWNA(ki,I)=Adn/real(NDOWN) DOWNU(ki,I)=(u(ki-1)*DZ(ki) + u(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) DOWNV(ki,I)=(v(ki-1)*DZ(ki) + v(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) @@ -7144,16 +7167,21 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & enddo - !print*, " Begin integration of downdrafts:" DO I=1,NDOWN + dp = 500. + dl*real(I) ! diameter of plume (meters) !print *, "Plume # =", I,"=======================" DO k=DD_initK(I)-1,KTS+1,-1 + + !Entrainment from Tian and Kuang (2016), with constraints + wmin = 0.3 + dp*0.0005 + ENT(k,i) = 0.33/(MIN(MAX(-1.0*DOWNW(k+1,I),wmin),0.9)*dp) + !starting at the first interface level below cloud top !EntExp=exp(-ENT(K,I)*dz(k)) !EntExp_M=exp(-ENT(K,I)/3.*dz(k)) - EntExp =ENT(K,I)*dz(k) - EntExp_M=ENT(K,I)*0.333*dz(k) + EntExp =ENT(K,I)*dz(k) !for all scalars + EntExp_M=ENT(K,I)*0.333*dz(k) !test for momentum QTn =DOWNQT(k+1,I) *(1.-EntExp) + QT(k)*EntExp THLn=DOWNTHL(k+1,I)*(1.-EntExp) + THL(k)*EntExp @@ -7187,11 +7215,11 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & BCOEFF*B/mindownw)*MIN(dz(k), 250.) !Do not allow a parcel to accelerate more than 1.25 m/s over 200 m. - !Add max increase of 2.0 m/s for coarse vertical resolution. - IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0))THEN - Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0) + !Add max acceleration of -2.0 m/s for coarse vertical resolution. + IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0))THEN + Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0) ENDIF - !Add symmetrical max decrease in w + !Add symmetrical max decrease in velocity (less negative) IF (Wn > DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0))THEN Wn = DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0) ENDIF @@ -7237,7 +7265,6 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! Even though downdraft starts at different height, average all up to qlTop DO k=qlTop,KTS,-1 DO I=1,NDOWN - IF (I > NDOWN) exit edmf_a_dd(K) =edmf_a_dd(K) +DOWNA(K-1,I) edmf_w_dd(K) =edmf_w_dd(K) +DOWNA(K-1,I)*DOWNW(K-1,I) edmf_qt_dd(K) =edmf_qt_dd(K) +DOWNA(K-1,I)*DOWNQT(K-1,I) @@ -7287,8 +7314,8 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing - real(kind_phys), INTENT(IN) :: dx,pbl1 - real(kind_phys), INTENT(OUT) :: Psig_bl,Psig_shcu + real(kind_phys), intent(in) :: dx,pbl1 + real(kind_phys), intent(out) :: Psig_bl,Psig_shcu real(kind_phys) :: dxdh Psig_bl=1.0 @@ -7361,28 +7388,28 @@ FUNCTION esat_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: esat_blend,XC,ESL,ESI,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common to 240 @@ -7412,28 +7439,28 @@ FUNCTION qsat_blend(t, P) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t, P + real(kind_phys), intent(in):: t, P real(kind_phys):: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) @@ -7470,7 +7497,7 @@ FUNCTION xl_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: xl_blend,xlvt,xlst,chi !note: t0c = 273.15, tice is set in mynn_common @@ -7499,11 +7526,11 @@ FUNCTION phim(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phi_m,phim if ( zet >= 0.0 ) then @@ -7551,11 +7578,11 @@ FUNCTION phih(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phh,phih if ( zet >= 0.0 ) then diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index ca913c6e3..027c6f090 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1416,6 +1416,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qcten1(k) = 0. endif initialize_extended_diagnostics enddo + lsml = lsm(i,j) if (is_aerosol_aware .or. merra2_aerosol_aware) then do k = kts, kte nc1d(k) = nc(i,k,j) @@ -1423,7 +1424,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nifa1d(k) = nifa(i,k,j) enddo else - lsml = lsm(i,j) do k = kts, kte if(lsml == 1) then nc1d(k) = Nt_c_l/rho(k) @@ -5358,14 +5358,15 @@ end subroutine table_ccnAct ! TO_DO ITEM: For radiation cooling producing fog, in which case the !.. updraft velocity could easily be negative, we could use the temp !.. and its tendency to diagnose a pretend postive updraft velocity. - real function activ_ncloud(Tt, Ww, NCCN) + real function activ_ncloud(Tt, Ww, NCCN, lsm_in) implicit none REAL, INTENT(IN):: Tt, Ww, NCCN + INTEGER, INTENT(IN):: lsm_in REAL:: n_local, w_local INTEGER:: i, j, k, l, m, n REAL:: A, B, C, D, t, u, x1, x2, y1, y2, nx, wy, fraction - + REAL:: lower_lim_nuc_frac ! ta_Na = (/10.0, 31.6, 100.0, 316.0, 1000.0, 3160.0, 10000.0/) ntb_arc ! ta_Ww = (/0.01, 0.0316, 0.1, 0.316, 1.0, 3.16, 10.0, 31.6, 100.0/) ntb_arw @@ -5412,6 +5413,14 @@ real function activ_ncloud(Tt, Ww, NCCN) l = 3 m = 2 + if (lsm_in .eq. 1) then ! land + lower_lim_nuc_frac = 0. + else if (lsm_in .eq. 0) then ! water + lower_lim_nuc_frac = 0.15 + else + lower_lim_nuc_frac = 0.15 ! catch-all for anything else + endif + A = tnccn_act(i-1,j-1,k,l,m) B = tnccn_act(i,j-1,k,l,m) C = tnccn_act(i,j,k,l,m) @@ -5426,7 +5435,8 @@ real function activ_ncloud(Tt, Ww, NCCN) ! u = (w_local-ta_Ww(j-1))/(ta_Ww(j)-ta_Ww(j-1)) fraction = (1.0-t)*(1.0-u)*A + t*(1.0-u)*B + t*u*C + (1.0-t)*u*D - + fraction = MAX(fraction, lower_lim_nuc_frac) + ! if (NCCN*fraction .gt. 0.75*Nt_c_max) then ! write(*,*) ' DEBUG-GT ', n_local, w_local, Tt, i, j, k ! endif @@ -5846,6 +5856,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & endif lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) + if (lsml .ne. 1) re_qc1d(k) = max(re_qc1d(k), 7.0E-6) enddo endif diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index eecc5493c..17f682218 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -26,7 +26,7 @@ MODULE module_sf_mynn ! ! LAND only: ! "iz0tlnd" namelist option is used to select the following momentum options: -! (default) =0: Zilitinkevich (1995); Czil now set to 0.085 +! (default) =0: Zilitinkevich (1995); Czil now set to 0.095 ! =1: Czil_new (modified according to Chen & Zhang 2008) ! =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (original form; Garratt 1992) @@ -225,7 +225,7 @@ SUBROUTINE SFCLAY_mynn( & ! (water =1: z0 from Davis et al (2008), zt & zq from COARE3.0/3.5 ! only) =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 -!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.085, +!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.095, ! (land =1: Czil_new (modified according to Chen & Zhang 2008) ! only) =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (Garratt 1992) @@ -2604,7 +2604,7 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& IF ( IZ0TLND2 .EQ. 1 ) THEN CZIL = 10.0 ** ( -0.40 * ( Z_0 / 0.07 ) ) ELSE - CZIL = 0.085 !0.075 !0.10 + CZIL = 0.095 !0.075 !0.10 END IF Zt = Z_0*EXP(-KARMAN*CZIL*SQRT(restar)) diff --git a/physics/mynnedmf_wrapper.F90 b/physics/mynnedmf_wrapper.F90 index 3c7de235f..46db1c441 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/mynnedmf_wrapper.F90 @@ -131,7 +131,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_plume, & + & maxwidth,maxMF,ztop_plume, & + & ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw @@ -310,9 +311,9 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), dimension(:), intent(out) :: & & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & - & maxMF + & maxMF,maxwidth,ztop_plume integer, dimension(:), intent(inout) :: & - & kpbl,nupdraft,ktop_plume + & kpbl,ktop_plume real(kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl @@ -748,7 +749,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,& !output & sub_thl3D=sub_thl,sub_sqv3D=sub_sqv, & & det_thl3D=det_thl,det_sqv3D=det_sqv, & - & nupdraft=nupdraft,maxMF=maxMF, & !output + & maxwidth=maxwidth,maxMF=maxMF,ztop_plume=ztop_plume,& !output & ktop_plume=ktop_plume, & !output & spp_pbl=spp_pbl,pattern_spp_pbl=spp_wts_pbl, & !input & RTHRATEN=htrlw, & !input @@ -1005,8 +1006,8 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs) print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs) print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs) - print*,"ktop_plume:",ktop_plume(1)," maxmf:",maxmf(1) - print*,"nup:",nupdraft(1) + print*,"ztop_plume:",ztop_plume(1)," maxmf:",maxmf(1) + print*,"maxwidth:",maxwidth(1) print* endif diff --git a/physics/mynnedmf_wrapper.meta b/physics/mynnedmf_wrapper.meta index ec4706aba..8614d3ba2 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/mynnedmf_wrapper.meta @@ -964,13 +964,14 @@ type = real kind = kind_phys intent = inout -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count +[maxwidth] + standard_name = maximum_width_of_plumes + long_name = maximum width of plumes per grid column + units = m dimensions = (horizontal_loop_extent) - type = integer - intent = inout + type = real + kind = kind_phys + intent = out [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -979,6 +980,14 @@ type = real kind = kind_phys intent = out +[ztop_plume] + standard_name = height_of_tallest_plume_in_a_column + long_name = height of tallest plume in a column + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [ktop_plume] standard_name = k_level_of_highest_plume long_name = k-level of highest plume From 14c58871eb4a91fab9d88632b6a1f0e404ad96fb Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Tue, 17 Oct 2023 16:36:31 +0000 Subject: [PATCH 042/122] missed a variable in the argument for activ_ncloud during the intial merge. --- physics/module_mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 027c6f090..d483ec0c2 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -3581,7 +3581,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! DROPLET NUCLEATION if (clap .gt. eps) then if (is_aerosol_aware .or. merra2_aerosol_aware) then - xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k))) + xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k), lsml)) else if(lsml == 1) then xnc = Nt_c_l From fe5322b0da1fa904f1cb36ff8b1a99b67c14495f Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 18 Oct 2023 18:53:03 +0000 Subject: [PATCH 043/122] Addressed the reviewer's comments. --- physics/lsm_ruc.F90 | 47 +++++++++++++++++---------------------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index d3754b68c..79bcbf7b1 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -649,38 +649,27 @@ subroutine lsm_ruc_run & ! inputs nsoil = lsoil_ruc do i = 1, im ! i - horizontal loop - ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 - if(kdt == 1) then - if(.not. land(i)) then - !water and sea ice - smcref (i,1) = one - smcwlt (i,1) = zero - xlai (i,1) = zero + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + elseif (kdt == 1) then + !land + ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 + smcref (i,1) = REFSMC(stype(i)) + smcwlt (i,1) = WLTSMC(stype(i)) + !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start + if(rdlai) then + xlai(i,1) = laixy(i) else - !land - smcref (i,1) = REFSMC(stype(i)) - smcwlt (i,1) = WLTSMC(stype(i)) - - !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start - if(rdlai) then - xlai(i,1) = laixy(i) - else - xlai(i,1) = LAITBL(vtype(i)) - endif + xlai(i,1) = LAITBL(vtype(i)) endif else - !-- if kdt > 1, parameters with sub-grid heterogeneity - if(.not. land(i)) then - !water and sea ice - smcref (i,1) = one - smcwlt (i,1) = zero - xlai (i,1) = zero - else - !land - smcref (i,1) = smcref2 (i) - smcwlt (i,1) = smcwlt2 (i) - xlai (i,1) = laixy (i) - endif + !-- land and kdt > 1, parameters has sub-grid heterogeneity + smcref (i,1) = smcref2 (i) + smcwlt (i,1) = smcwlt2 (i) + xlai (i,1) = laixy (i) endif enddo From 056f42021aa0a12715bbc07bfe85a2222759b41b Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 18 Oct 2023 19:00:20 +0000 Subject: [PATCH 044/122] Changes in module_sf_ruclsm.F90: 1. Removed commented lines in fire feedback to RUC LSM. 2. The coordinates of a test point are passed to the RUC LSM subroutines to make debug printing more manageable. 3. Reverted change in the TRANSF subroutine to original version. The non-linear root distribution needs scientific evaluation in the retro runs. --- physics/module_sf_ruclsm.F90 | 119 +++++++++++++++++++++++------------ 1 file changed, 79 insertions(+), 40 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 2bb29d440..83d7a04d6 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1853,7 +1853,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ilands = ivgtyp - CALL SOIL(debug_print,xlat,xlon, & + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,gswin, & @@ -2068,9 +2068,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac - !IF ( add_fire_heat_flux ) then ! JLS - ! hfx = hfx + fire_heat_flux - !ENDIF s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) sublim = sublim*snowfrac @@ -2116,9 +2113,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac - !IF ( add_fire_heat_flux ) then ! JLS - ! hfx = hfx + fire_heat_flux - !ENDIF s = ss*(one-snowfrac) + s*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac @@ -2248,7 +2242,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(SEAICE .LT. 0.5_kind_phys) then ! LAND - CALL SOIL(debug_print,xlat,xlon, & + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,GSWin, & @@ -2341,7 +2335,7 @@ END FUNCTION QSN !>\ingroup lsm_ruc_group !> This subroutine calculates energy and moisture budget for vegetated surfaces !! without snow, heat diffusion and Richards eqns in soil. - SUBROUTINE SOIL (debug_print,xlat,xlon, & + SUBROUTINE SOIL (debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,& !--- input variables PRCPMS,RAINF,PATM,QVATM,QCATM, & GLW,GSW,GSWin,EMISS,RNET, & @@ -2423,7 +2417,8 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon LOGICAL, INTENT(IN ) :: myj !--- 3-D Atmospheric variables real (kind_phys), & @@ -2647,6 +2642,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -2682,6 +2678,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -2739,7 +2736,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! SOILTEMP soilves heat budget and diffusion eqn. in soil !************************************************************** - CALL SOILTEMP(debug_print,xlat,xlon, & + CALL SOILTEMP(debug_print,xlat,xlon,testptlat,testptlon,& !--- input variables i,j,iland,isoil, & delt,ktau,conflx,nzs,nddzs,nroot, & @@ -2809,6 +2806,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! and Richards eqn. !************************************************************************* CALL SOILMOIST (debug_print, & + xlat, xlon, testptlat, testptlon, & !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -3603,6 +3601,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -3653,6 +3652,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -3748,7 +3748,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & !--- TQCAN FOR SOLUTION OF MOISTURE BALANCE (Smirnova et al. 1996, EQ.22,28) ! AND TSO,ETA PROFILES !************************************************************************* - CALL SOILMOIST (debug_print, & + CALL SOILMOIST (debug_print,xlat,xlon,testptlat,testptlon,& !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -4704,7 +4704,7 @@ END SUBROUTINE SNOWSEAICE !>\ingroup lsm_ruc_group !> This subroutine solves energy budget equation and heat diffusion !! equation. - SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & + SUBROUTINE SOILTEMP( debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil, & !--- input variables delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,TABS,QVATM,QCATM, & @@ -4774,7 +4774,8 @@ SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon real (kind_phys), INTENT(INOUT) :: DRYCAN,WETCAN,TRANSUM !--- 3-D Atmospheric variables real (kind_phys), & @@ -5984,6 +5985,7 @@ END SUBROUTINE SNOWTEMP !! This subroutine solves moisture budget and computes soil moisture !! and surface and sub-surface runoffs. SUBROUTINE SOILMOIST ( debug_print, & + xlat, xlon, testptlat, testptlon, & DELT,NZS,NDDZS,DTDZS,DTDZS2,RIW, & !--- input parameters ZSMAIN,ZSHALF,DIFFU,HYDRO, & QSG,QVG,QCG,QCATM,QVATM,PRCP, & @@ -6037,6 +6039,7 @@ SUBROUTINE SOILMOIST ( debug_print, & !--- input variables LOGICAL, INTENT(IN ) :: debug_print real (kind_phys), INTENT(IN ) :: DELT + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon INTEGER, INTENT(IN ) :: NZS,NDDZS ! input variables @@ -6124,8 +6127,12 @@ SUBROUTINE SOILMOIST ( debug_print, & DENOM=one+X2+X4-Q2*COSMC(K) COSMC(K+1)=Q4/DENOM IF (debug_print ) THEN - print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & - ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & + ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + endif ENDIF RHSMC(K+1)=(SOILMOIS(KN)+Q2*RHSMC(K) & +TRANSP(KN) & @@ -6156,8 +6163,12 @@ SUBROUTINE SOILMOIST ( debug_print, & TOTLIQ=PRCP-DRIP/DELT-(one-VEGFRAC)*DEW*RAS-SMELT IF (debug_print ) THEN -print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & - UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & + UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + endif ENDIF FLX=TOTLIQ @@ -6200,7 +6211,7 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX1 = zero ENDIF IF (debug_print ) THEN - print *,'INFMAX1 before frozen part',INFMAX1 + print *,'INFMAX1 before frozen part',INFMAX1 ENDIF ! ----------- FROZEN GROUND VERSION -------------------------- @@ -6234,8 +6245,8 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX = MAX(INFMAX1,HYDRO(1)*SOILMOIS(1)) INFMAX = MIN(INFMAX, -TOTLIQ) IF (debug_print ) THEN -print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & - INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ + print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & + INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ ENDIF !---- IF (-TOTLIQ.GT.INFMAX)THEN @@ -6285,8 +6296,12 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF IF (debug_print ) THEN - print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw - print *,'COSMC,RHSMC',COSMC,RHSMC + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw + print *,'COSMC,RHSMC',COSMC,RHSMC + endif ENDIF !--- FINAL SOLUTION FOR SOILMOIS ! DO K=2,NZS1 @@ -6312,7 +6327,11 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF END DO IF (debug_print ) THEN - print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + endif ENDIF MAVAIL=max(.00001_kind_phys,min(one,(SOILMOIS(1)/(REF-QMIN)*(one-snowfrac)+one*snowfrac))) @@ -6324,6 +6343,7 @@ END SUBROUTINE SOILMOIST !! This subroutine computes thermal diffusivity, and diffusional and !! hydraulic condeuctivities in soil. SUBROUTINE SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & nzs,fwsat,lwsat,tav,keepfr, & !--- input variables soilmois,soiliqw,soilice, & soilmoism,soiliqwm,soilicem, & @@ -6357,6 +6377,8 @@ SUBROUTINE SOILPROP( debug_print, & !--- soil properties LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: NZS + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon + real (kind_phys) , & INTENT(IN ) :: RHOCS, & BCLH, & @@ -6533,6 +6555,7 @@ END SUBROUTINE SOILPROP !> This subroutine solves the transpiration function (EQs. 18,19 in !! Smirnova et al.(1997) \cite Smirnova_1997) SUBROUTINE TRANSF( debug_print, & + xlat,xlon,testptlat,testptlon, & nzs,nroot,soiliqw,tabs,lai,gswin, & !--- input variables dqm,qmin,ref,wilt,zshalf,pc,iland, & !--- soil fixed fields tranf,transum) !--- output variables @@ -6553,6 +6576,7 @@ SUBROUTINE TRANSF( debug_print, & LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: nroot,nzs,iland + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon real (kind_phys) , & INTENT(IN ) :: GSWin, TABS, lai @@ -6599,7 +6623,7 @@ SUBROUTINE TRANSF( debug_print, & ap4=59.656_kind_phys gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(2) @@ -6612,7 +6636,7 @@ SUBROUTINE TRANSF( debug_print, & TRANF(1)=(TOTLIQ-WILT)/(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution - TRANF(1)=part(1) + !TRANF(1)=part(1) DO K=2,NROOT totliq=soiliqw(k)+qmin @@ -6622,7 +6646,7 @@ SUBROUTINE TRANSF( debug_print, & sm4=sm3*sm1 gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(K+1)-zshalf(K) @@ -6636,8 +6660,16 @@ SUBROUTINE TRANSF( debug_print, & /(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution - TRANF(k)=part(k) + !TRANF(k)=part(k) END DO + IF (debug_print ) THEN + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'soiliqw =',soiliqw,'wilt=',wilt,'qmin= ',qmin + print *,'tranf = ',tranf + endif + ENDIF ! For LAI> 3 => transpiration at potential rate (F.Tardieu, 2013) if(lai > 4._kind_phys) then @@ -6649,7 +6681,11 @@ SUBROUTINE TRANSF( debug_print, & ! pctot=min(0.8,max(pc,pc*lai)) endif IF ( debug_print ) THEN - print *,'pctot,lai,pc',pctot,lai,pc + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'pctot,lai,pc',pctot,lai,pc + endif ENDIF !--- !--- air temperature function @@ -6659,9 +6695,6 @@ SUBROUTINE TRANSF( debug_print, & ELSE FTEM = one / (one + EXP(0.5_kind_phys * (TABS - 314.0_kind_phys))) ENDIF - IF ( debug_print ) THEN - print *,'tabs,ftem',tabs,ftem - ENDIF !--- incoming solar function cmin = one/rsmax_data cmax = one/rstbl(iland) @@ -6684,27 +6717,33 @@ SUBROUTINE TRANSF( debug_print, & else fsol = one endif - IF ( debug_print ) THEN - print *,'GSWin,lai,f1,fsol',gswin,lai,f1,fsol - ENDIF !--- total conductance totcnd =(cmin + (cmax - cmin)*pctot*ftem*fsol)/cmax IF ( debug_print ) THEN - print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & - ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol',GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol + print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & + ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + endif ENDIF !-- TRANSUM - total for the rooting zone transum=zero DO K=1,NROOT ! linear root distribution - TRANF(k)=max(cmin,TRANF(k)*totcnd) + TRANF(k)=max(zero,TRANF(k)*totcnd) transum=transum+tranf(k) END DO IF ( debug_print ) THEN - print *,'transum,TRANF',transum,tranf - endif + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'transum,TRANF',transum,tranf + endif + ENDIF !----------------------------------------------------------------- END SUBROUTINE TRANSF From ffb091280816bb1aac4ea92b421314c0c695cb3c Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Thu, 19 Oct 2023 17:19:27 +0000 Subject: [PATCH 045/122] Adding back a missing exclamation point in module_bl_mynn.F90 and adding a limit to protect against the ridiculously large z0s when using thin first model levels in module_sf_mynn.F90 --- physics/module_bl_mynn.F90 | 2 +- physics/module_sf_mynn.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 943a5c81d..18a385ba7 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,5 +1,5 @@ !>\file module_bl_mynn.F90 -! This file contains the entity of MYNN-EDMF PBL scheme. +!! This file contains the entity of MYNN-EDMF PBL scheme. ! ********************************************************************** ! * An improved Mellor-Yamada turbulence closure model * ! * * diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 17f682218..c2845f290 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -1380,6 +1380,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & else ZNTstoch_lnd(I) = ZNT_lnd(I) endif + !add limit to prevent ridiculous values of z0 (more than dz/15) + ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666) !-------------------------------------- ! LAND From 5592fc4fe88ac2c704eccf6fa01b8ff875135726 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 19 Oct 2023 17:42:47 +0000 Subject: [PATCH 046/122] Metafile cleanup --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta | 8 ++++---- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta | 3 ++- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta | 4 ++-- .../UFS_SCM_NEPTUNE/GFS_radiation_surface.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta | 6 +++--- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta | 6 +++--- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta | 2 +- .../Morrison_Gettelman}/aerinterp.F90 | 0 physics/h2o_photo/h2o_def.meta | 2 +- physics/o3_photo/ozne_def.meta | 2 +- 14 files changed, 22 insertions(+), 21 deletions(-) rename physics/{Interstitials/UFS_SCM_NEPTUNE => MP/Morrison_Gettelman}/aerinterp.F90 (100%) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index de3f49a6f..10eb43671 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -200,7 +200,7 @@ [ccpp-table-properties] name = GFS_interstitialtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -399,7 +399,7 @@ [ccpp-table-properties] name = GFS_abort type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -439,7 +439,7 @@ [ccpp-table-properties] name = GFS_checkland type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -698,7 +698,7 @@ [ccpp-table-properties] name = GFS_checktracers type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 2aec034fd..7df4cf715 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -3,7 +3,8 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/gcycle.F90,Interstitials/UFS_SCM_NEPTUNE/iccn_def.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index d033c889b..e1de4d699 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -3,8 +3,8 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F - dependencies = Radiation/mersenne_twister.f + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 + dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 79837d0bf..686bd3c6c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -2,7 +2,7 @@ name = GFS_radiation_surface type = scheme relative_path = ../../ - dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f + dependencies = Radiation/radiation_surface.f dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 dependencies = hooks/machine.F diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta index c84b9da31..b387c3e33 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f + dependencies = Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index af95daf52..72495eac5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -3,10 +3,10 @@ type = scheme relative_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F - dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompsonmodule_mp_thompson_make_number_concentrations.F90 - dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f + dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90 + dependencies = Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f - dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f,Radiation/radiation_cloud_overlap.F90 dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index 0c199deaa..a9fbf91d9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -3,9 +3,9 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Radiaiton/iounitdef.f,Radiaiton/RRTMG/radcons.f90,Radiaiton/radiation_aerosols.f - dependencies = Radiaiton/radiation_astronomy.f,Radiaiton/radiation_clouds.f,Radiaiton/radiation_gases.f - dependencies = Radiaiton/radlw_main.F90,Radiaiton/radlw_param.f,Radiaiton/radsw_main.F90,Radiaiton/radsw_param.f + dependencies = Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/RRTMG/radlw_main.F90,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_main.F90,Radiation/RRTMG/radsw_param.f dependencies = MP/Thompson/module_mp_thompson.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta index c21c2ef7c..5b355849a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_post type = scheme relative_path = ../../ - dependencies = Radiation/iounitdef.f,hooks/machine.F,Radiation/radiation_aerosols.f + dependencies = hooks/machine.F,Radiation/radiation_aerosols.f dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta index ae67ef51b..ddc95c55c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_pre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta index 5d21e1910..14c1f91cd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 - dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_aerosols.f dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index c9fd5950c..9829e3538 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -2,7 +2,7 @@ name = sgscloud_radpre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,Radiation/iounitdef.f,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 similarity index 100% rename from physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 rename to physics/MP/Morrison_Gettelman/aerinterp.F90 diff --git a/physics/h2o_photo/h2o_def.meta b/physics/h2o_photo/h2o_def.meta index 3bb9bf94d..92e1d61bd 100644 --- a/physics/h2o_photo/h2o_def.meta +++ b/physics/h2o_photo/h2o_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2o_def type = module - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F [ccpp-arg-table] name = h2o_def diff --git a/physics/o3_photo/ozne_def.meta b/physics/o3_photo/ozne_def.meta index 3123892bb..bdb51ce8d 100644 --- a/physics/o3_photo/ozne_def.meta +++ b/physics/o3_photo/ozne_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozne_def type = module - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F [ccpp-arg-table] name = ozne_def From e627b189236c8ddc7d6a41683e1526b458413336 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 19 Oct 2023 17:51:25 +0000 Subject: [PATCH 047/122] Move rte-rrtmgp submodule --- .gitmodules | 3 +++ physics/Radiation/RRTMGP/rte-rrtmgp | 1 + 2 files changed, 4 insertions(+) create mode 160000 physics/Radiation/RRTMGP/rte-rrtmgp diff --git a/.gitmodules b/.gitmodules index c82541c5b..24b9cf118 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,3 +2,6 @@ path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main +[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] + path = physics/Radiation/RRTMGP/rte-rrtmgp + url = https://github.com/earth-system-radiation/rte-rrtmgp diff --git a/physics/Radiation/RRTMGP/rte-rrtmgp b/physics/Radiation/RRTMGP/rte-rrtmgp new file mode 160000 index 000000000..74a0e098b --- /dev/null +++ b/physics/Radiation/RRTMGP/rte-rrtmgp @@ -0,0 +1 @@ +Subproject commit 74a0e098b2163425e4b5466c2dfcf8ae26d560a5 From 91415d42d51059697e8d0c03f8b7f00e3fb7aea3 Mon Sep 17 00:00:00 2001 From: "Xiaqiong.Zhou" Date: Fri, 20 Oct 2023 14:45:01 +0000 Subject: [PATCH 048/122] Add a switch to turn off samfdeepcnv when the MYNN shallow convection is active --- physics/samfdeepcnv.f | 6 ++++-- physics/samfdeepcnv.meta | 15 +++++++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 8a36fe34c..94a4cd148 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -83,7 +83,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain, sigmaout, errmsg,errflg) + & rainevap,sigmain, sigmaout, maxMF, do_mynnedmf, errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -99,11 +99,12 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:) real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & - & progsigma + & progsigma,do_mynnedmf real(kind=kind_phys), intent(in) :: nthresh real(kind=kind_phys), intent(in) :: ca_deep(:) real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & & tmf(:,:,:),q(:,:), prevsq(:,:) + real(kind=kind_phys), dimension (:), intent(in) :: maxMF real(kind=kind_phys), intent(out) :: rainevap(:) real(kind=kind_phys), intent(out) :: sigmaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger @@ -347,6 +348,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do i=1,im cnvflg(i) = .true. + if(do_mynnedmf.and.(maxMF(i).gt.0.))cnvflg(i)=.false. sfcpbl(i) = sfclfac * hpbl(i) rn(i)=0. mbdt(i)=10. diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index bed4d655d..86c713a06 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -450,6 +450,21 @@ type = real kind = kind_phys intent = out +[maxMF] + standard_name = maximum_mass_flux + long_name = maximum mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[do_mynnedmf] + standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water From a515ec34081d5b55894191b15655e5f83c96de3b Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 23 Oct 2023 18:19:59 +0000 Subject: [PATCH 049/122] Based on 1-D testing in ESM-SnowMIP a change to computation of snow thermal conductivity is made in module_sf_ruclsm.F90. --- physics/module_sf_ruclsm.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 83d7a04d6..fe02ccdc8 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -4071,7 +4071,7 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOnewCSN=sheatsn * RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4088,13 +4088,13 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4535,7 +4535,7 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4552,13 +4552,13 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5219,7 +5219,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN RHOnewCSN=sheatsn* RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5236,10 +5236,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys if(debug_print) then print *,'SnowTemp xlat,xlon,rhosn,keff', xlat,xlon,rhosn,keff,keff/rhocsn*fact print *,'SNOWTEMP - 0.265/rhocsn',0.265_kind_phys/rhocsn @@ -5249,7 +5249,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & print *,'SNOWTEMP - xlat,xlon,newsnow,rhonewsn,rhosn,fact,keff',xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5802,7 +5802,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5819,10 +5819,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys if(debug_print) then print *,'End SNOWTEMP - xlat,xlon,rhosn,keff',xlat,xlon,rhosn,keff print *,'End SNOWTEMP - 0.265/rhocsn',0.265/rhocsn @@ -5833,7 +5833,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff,keff/rhocsn*fact endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. From b314eabab45297076deaad068e5d30f1fa6eab68 Mon Sep 17 00:00:00 2001 From: Xiaqiong Zhou Date: Tue, 24 Oct 2023 13:30:32 +0000 Subject: [PATCH 050/122] Fix the undefined dimension issue for maxmf in tests with GNU debug --- physics/samfdeepcnv.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 94a4cd148..7bf9cd2f5 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -348,7 +348,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do i=1,im cnvflg(i) = .true. - if(do_mynnedmf.and.(maxMF(i).gt.0.))cnvflg(i)=.false. + if(do_mynnedmf) then + if(maxMF(i).gt.0.)cnvflg(i)=.false. + endif sfcpbl(i) = sfclfac * hpbl(i) rn(i)=0. mbdt(i)=10. From ce11da759b562845cee1722ec36e8f46aebd0c67 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 24 Oct 2023 17:28:40 +0000 Subject: [PATCH 051/122] In module_sf_ruclsm.F90: clean-up comments, changed the constant for hard snow slab thermal conductivity. --- physics/module_sf_ruclsm.F90 | 76 ++++++++++++------------------------ 1 file changed, 24 insertions(+), 52 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index fe02ccdc8..74d2719d4 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -4071,23 +4071,15 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOnewCSN=sheatsn * RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is tuning parameter added by tgs based on 4 Jan 2017 testing !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -4097,9 +4089,10 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -4535,23 +4528,15 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -4561,9 +4546,10 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5219,23 +5205,15 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN RHOnewCSN=sheatsn* RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -5252,9 +5230,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5802,23 +5781,15 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -5836,9 +5807,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif From 2fc4a64040e36f150af41890270112b1abc3200d Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Tue, 24 Oct 2023 22:11:54 +0000 Subject: [PATCH 052/122] Updates to bring out tuning parameters in C3 and SAS convection schemes --- physics/cu_c3_deep.F90 | 26 ++++++++++++++++++-------- physics/cu_c3_driver.F90 | 16 ++++++++++++---- physics/cu_c3_driver.meta | 23 +++++++++++++++++++++++ physics/cu_c3_sh.F90 | 23 ++++++++++++++--------- physics/progsigma_calc.f90 | 31 ++++++++++++++++++++----------- physics/samfdeepcnv.f | 19 +++++++++++-------- physics/samfdeepcnv.meta | 23 +++++++++++++++++++++++ physics/samfshalcnv.f | 19 +++++++++++-------- physics/samfshalcnv.meta | 23 +++++++++++++++++++++++ 9 files changed, 155 insertions(+), 48 deletions(-) diff --git a/physics/cu_c3_deep.F90 b/physics/cu_c3_deep.F90 index 7092840c3..7e907aaba 100644 --- a/physics/cu_c3_deep.F90 +++ b/physics/cu_c3_deep.F90 @@ -97,6 +97,9 @@ subroutine cu_c3_deep_run( & ,tmf & ! instantanious tendency from turbulence ,qmicro & ! instantanious tendency from microphysics ,forceqv_spechum & !instantanious tendency from dynamics + ,betascu & ! Tuning parameter for shallow clouds + ,betamcu & ! Tuning parameter for mid-level clouds + ,betadcu & ! Tuning parameter for deep clouds ,sigmain & ! input area fraction after advection ,sigmaout & ! updated prognostic area fraction ,z1 & ! terrain @@ -233,8 +236,8 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys) & - ,intent (in ) :: & - dtime,ccnclean,fv,r_d + ,intent (in ) :: & + dtime,ccnclean,fv,r_d,betascu,betamcu,betadcu ! @@ -386,13 +389,16 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys), dimension (its:ite) :: pefc real(kind=kind_phys) entdo,dp,subin,detdo,entup, & detup,subdown,entdoj,entupk,detupk,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys), dimension (its:ite) :: lambau,flux_tun,zws,ztexec,zqexec !$acc declare create(lambau,flux_tun,zws,ztexec,zqexec) integer :: jprnt,jmini,start_k22 logical :: keep_going,flg(its:ite),cnvflg(its:ite) - logical :: flag_shallow + logical :: flag_shallow,flag_mid !$acc declare create(flg) @@ -1988,7 +1994,11 @@ subroutine cu_c3_deep_run( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then + flag_mid = .false. flag_shallow = .false. + if(imid.eq.1)then + flag_mid = .true. + endif do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -2003,9 +2013,9 @@ subroutine cu_c3_deep_run( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !$acc end kernels @@ -3147,7 +3157,7 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 ! pcrit,acrit,acritt integer, dimension (its:ite) :: kloc real(kind=kind_phys) :: & - a1,a_ave,xff0,xomg,gravinv!,aclim1,aclim2,aclim3,aclim4 + a1,a_ave,xff0,xomg,gravinv real(kind=kind_phys), dimension (its:ite) :: ens_adj !$acc declare create(kloc,ens_adj) @@ -5748,7 +5758,7 @@ subroutine calculate_updraft_velocity(its,itf,ktf,ite,kts,kte,ierr,progsigma, do k = 2, ktf-1 do i = 1, itf if (ierr(i)==0) then - if(k >= kbcon(i) .and. k < ktcon(i))then + if(k >= kbcon(i) .and. k < ktcon(i) .and. dbyo(i,k)>0.)then gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) if(k >= kbcon(i) .and. clw_all(i,k)>0.)then buo(i,k) = buo(i,k) - g * qlk(i,k) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 8592e08f9..0ecb81750 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -60,7 +60,8 @@ end subroutine cu_c3_driver_init subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & - qv_spechum,t,cld1d,us,vs,t2di,w,qv2di_spechum,p2di,psuri, & + betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & + qv2di_spechum,p2di,psuri, & hbot,htop,kcnv,xland,hfx2,qfx2,aod_gf,cliw,clcw,ca_deep,rainevap,& pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & @@ -97,7 +98,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & do_ca,progsigma - real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v + real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d real(kind=kind_phys), intent(inout) :: dtend(:,:,:) @@ -587,7 +588,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& hfx(i)=hfx2(i)*cp*rhoi(i,1) qfx(i)=qfx2(i)*xlv*rhoi(i,1) dx(i) = sqrt(garea(i)) - enddo + enddo do i=its,itf do k=kts,kpbli(i) @@ -669,7 +670,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & ! Prog closure flag_init, flag_restart,fv,r_d,delp,tmfq,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain, & + sigmaout,progsigma,dx, & ! output tendencies outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, & ! dimesnional variables @@ -714,6 +716,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & @@ -805,6 +810,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index 999b5c2bc..e02116243 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -244,6 +244,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [phil] standard_name = geopotential long_name = layer geopotential diff --git a/physics/cu_c3_sh.F90 b/physics/cu_c3_sh.F90 index a79e1dfcf..704f2a0fc 100644 --- a/physics/cu_c3_sh.F90 +++ b/physics/cu_c3_sh.F90 @@ -68,7 +68,8 @@ subroutine cu_c3_sh_run ( & hfx,qfx,xland,ichoice,tcrit,dtime, & zuo,xmb_out,kbcon,ktop,k22,ierr,ierrc, & flag_init, flag_restart,fv,r_d,delp,tmf,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain,& + sigmaout,progsigma,dx, & outt,outq,outqc,outu,outv,cnvwt,pre,cupclw, & ! output tendencies itf,ktf,its,ite, kts,kte,ipr,tropics) ! dimesnional variables ! @@ -131,7 +132,7 @@ subroutine cu_c3_sh_run ( & real(kind=kind_phys) & ,intent (in ) :: & - dtime,tcrit,fv,r_d + dtime,tcrit,fv,r_d,betascu,betamcu,betadcu !$acc declare sigmaout real(kind=kind_phys), dimension (its:,kts:) & ,intent (out) :: & @@ -234,15 +235,18 @@ subroutine cu_c3_sh_run ( & !$acc cap_max_increment,lambau, & !$acc kstabi,xland1,kbmax,ktopx) - logical :: flag_shallow + logical :: flag_shallow,flag_mid logical, dimension(its:ite) :: cnvflg integer :: & kstart,i,k,ki - real(kind=kind_phys) :: & + real(kind=kind_phys) :: & dz,mbdt,zkbmax, & cap_maxs,trash,trash2,frh,el2orc,gravinv - real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys) xff_shal(3),blqe,xkshal character*50 :: ierrc(its:) @@ -672,13 +676,13 @@ subroutine cu_c3_sh_run ( & dz=z_cup(i,k)-z_cup(i,k-1) ! cloud liquid water c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1) + clw_all(i,k)=max(0.,qco(i,k)-trash) qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz) if(qrco(i,k).lt.0.)then ! hli new test 02/12/19 qrco(i,k)=0. !c1d(i,k)=0. endif pwo(i,k)=c0_shal*dz*qrco(i,k)*zuo(i,k) - clw_all(i,k)=qco(i,k)-trash !LB total cloud before rain and detrain ! cloud water vapor qco (i,k)= trash+qrco(i,k) @@ -960,6 +964,7 @@ subroutine cu_c3_sh_run ( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then flag_shallow = .true. + flag_mid = .false. do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -974,9 +979,9 @@ subroutine cu_c3_sh_run ( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif diff --git a/physics/progsigma_calc.f90 b/physics/progsigma_calc.f90 index c87308602..469df49f6 100644 --- a/physics/progsigma_calc.f90 +++ b/physics/progsigma_calc.f90 @@ -19,10 +19,10 @@ module progsigma !! This subroutine computes a prognostic updraft area fracftion !! used in the closure computations in the samfshalcnv. scheme !!\section gen_progsigma progsigma_calc General Algorithm - subroutine progsigma_calc (im,km,flag_init,flag_restart, & - flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & - delt,qadv,kbcon1,ktcon,cnvflg,sigmain,sigmaout, & - sigmab) + subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & + delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) ! ! use machine, only : kind_phys @@ -32,11 +32,12 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & ! intent in integer, intent(in) :: im,km,kbcon1(im),ktcon(im) - real(kind=kind_phys), intent(in) :: hvap,delt + real(kind=kind_phys), intent(in) :: hvap,delt,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins real(kind=kind_phys), intent(in) :: qadv(im,km),del(im,km), & qmicro(im,km),tmf(im,km),dbyo1(im,km),zdqca(im,km), & omega_u(im,km),zeta(im,km) - logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow + logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow,flag_mid real(kind=kind_phys), intent(in) :: sigmain(im,km) ! intent out @@ -53,15 +54,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, & fdqb,dtdyn,dxlim,rmulacvg,tem, & - DEN,betascu,betadcu,dp1,invdelt + DEN,dp1,invdelt !Parameters gcvalmx = 0.1 rmulacvg=10. epsilon=1.E-11 km1=km-1 - betadcu = 2.0 - betascu = 8.0 invdelt = 1./delt !Initialization 2D @@ -206,17 +205,27 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betascu - sigmab(i)=MAX(0.03,sigmab(i)) + sigmab(i)=MAX(sigmins,sigmab(i)) + endif + enddo + elseif(flag_mid)then + do i= 1, im + if(cnvflg(i)) then + sigmab(i)=sigmab(i)/betamcu + sigmab(i)=MAX(sigminm,sigmab(i)) endif enddo else do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betadcu - sigmab(i)=MAX(0.01,sigmab(i)) + sigmab(i)=MAX(sigmind,sigmab(i)) endif enddo endif + do i= 1, im + sigmab(i) = MIN(0.95,sigmab(i)) + enddo end subroutine progsigma_calc diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 8a36fe34c..e8faecf14 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -83,7 +83,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain, sigmaout, errmsg,errflg) + & rainevap,sigmain,sigmaout,betadcu,betamcu,betascu, & + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -100,14 +101,14 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & & progsigma - real(kind=kind_phys), intent(in) :: nthresh + real(kind=kind_phys), intent(in) :: nthresh,betadcu,betamcu, & + & betascu real(kind=kind_phys), intent(in) :: ca_deep(:) real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & & tmf(:,:,:),q(:,:), prevsq(:,:) real(kind=kind_phys), intent(out) :: rainevap(:) real(kind=kind_phys), intent(out) :: sigmaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger - integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & @@ -213,8 +214,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,invdelt - logical flag_shallow + real(kind=kind_phys) gravinv,invdelt,sigmind,sigminm,sigmins + parameter(sigmind=0.01,sigmins=0.03,sigminm=0.01) + logical flag_shallow, flag_mid c physical parameters ! parameter(grav=grav,asolfac=0.958) ! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) @@ -2930,10 +2932,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo flag_shallow = .false. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity for the grid sizes where the quasi-equilibrium assumption of Arakawa-Schubert is not valid any longer. diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index bed4d655d..d0d39d830 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -450,6 +450,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index a7682342f..3869ea6ea 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -57,7 +57,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & - & sigmain,sigmaout,errmsg,errflg) + & sigmain,sigmaout,betadcu,betamcu,betascu,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -67,7 +67,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & - & eps, epsm1, fv, grav, hvap, rd, rv, t0c + & eps, epsm1, fv, grav, hvap, rd, rv, t0c, betascu, betadcu, & + & betamcu real(kind=kind_phys), intent(in) :: delt real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:), & @@ -159,8 +160,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km), & sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,dxcrtas,invdelt - logical flag_shallow + real(kind=kind_phys) gravinv,dxcrtas,invdelt,sigmind,sigmins, + & sigminm + logical flag_shallow,flag_mid c physical parameters ! parameter(g=grav,asolfac=0.89) ! parameter(g=grav) @@ -194,7 +196,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) ! progsigma - parameter(dxcrtas=30.e3) + parameter(dxcrtas=30.e3,sigmind=0.01,sigmins=0.03,sigminm=0.01) c local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), @@ -1974,10 +1976,11 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo flag_shallow = .true. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity. diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index c1fffef58..200e33707 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -482,6 +482,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 12b400a210854d33e64fd6d211482d9f8ab7add5 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Wed, 25 Oct 2023 21:30:26 +0000 Subject: [PATCH 053/122] Ensure prognostic closure is not used at coarse resolution --- physics/cu_c3_deep.F90 | 2 +- physics/cu_c3_driver.F90 | 16 ++++++++++++---- physics/cu_c3_driver.meta | 7 +++++++ 3 files changed, 20 insertions(+), 5 deletions(-) diff --git a/physics/cu_c3_deep.F90 b/physics/cu_c3_deep.F90 index 7e907aaba..b7cd5f62d 100644 --- a/physics/cu_c3_deep.F90 +++ b/physics/cu_c3_deep.F90 @@ -5758,7 +5758,7 @@ subroutine calculate_updraft_velocity(its,itf,ktf,ite,kts,kte,ierr,progsigma, do k = 2, ktf-1 do i = 1, itf if (ierr(i)==0) then - if(k >= kbcon(i) .and. k < ktcon(i) .and. dbyo(i,k)>0.)then + if(k >= kbcon(i) .and. k < ktcon(i))then gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) if(k >= kbcon(i) .and. clw_all(i,k)>0.)then buo(i,k) = buo(i,k) - g * qlk(i,k) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 0ecb81750..5b6be1d6c 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -58,7 +58,7 @@ end subroutine cu_c3_driver_init !! !>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& - do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & + do_ca,progsigma,cnx,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & qv2di_spechum,p2di,psuri, & @@ -93,14 +93,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer + integer, intent(in ) :: im,km,ntracer,cnx integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & - do_ca,progsigma + do_ca real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d - + logical, intent(inout) :: progsigma real(kind=kind_phys), intent(inout) :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & @@ -280,6 +280,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc end kernels endif + + if(progsigma)then + if(cnx < 384)then + progsigma=.false. + write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' + endif + endif + if(ldiag3d) then if(flag_for_dcnv_generic_tend) then cliw_deep_idx=0 diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index e02116243..71a785318 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -133,6 +133,13 @@ units = flag dimensions = () type = logical + intent = inout +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer intent = in [cactiv] standard_name = counter_for_grell_freitas_convection From 454189320fb2b2105284836077b3b66a3dfc5f2e Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Wed, 25 Oct 2023 22:28:07 +0000 Subject: [PATCH 054/122] Further tweaks to improve the MYNN, will update the attached pdf. --- physics/module_bl_mynn.F90 | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 18a385ba7..f520ae171 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3868,6 +3868,14 @@ SUBROUTINE mym_condensation (kts,kte, & q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif + !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) + if (qs(k)>1.e-7 .and. zagl .gt. pblh2) then + rh_hack =min(1.0, rhcrit + 0.08*(7.0 + log10(qs(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif q1k = q1(k) ! backup Q1 for later modification @@ -5842,7 +5850,7 @@ SUBROUTINE DMP_mf( & real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & - qc_plume,exc_heat,exc_moist,tk_int + qc_plume,exc_heat,exc_moist,tk_int,tvs real(kind_phys), parameter :: Cdet = 1./45. real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to @@ -5967,16 +5975,17 @@ SUBROUTINE DMP_mf( & else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. endif + tvs = ts*(1.0+p608*qv(kts)) do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). if (k == 1) then - if ((th(k)-ts)/(0.5*dz(k)) < hux) then + if ((thv(k)-tvs)/(0.5*dz(k)) < hux) then superadiabatic = .true. else superadiabatic = .false. exit endif else - if ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then + if ((thv(k)-thv(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. else superadiabatic = .false. @@ -6052,10 +6061,14 @@ SUBROUTINE DMP_mf( & acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 15 m/s. + !the mass-flux scheme linearly above sfc wind speeds of 10 m/s. !Note: this effect may be better represented by an increase in !entrainment rate for high wind consitions (more ambient turbulence). - ac_wsp = 1.0 - min(max(wspd_pbl - 15.0, 0.0), 10.0)/10.0 + if (wspd_pbl .le. 10.) then + ac_wsp = 1.0 + else + ac_wsp = 1.0 - min((wspd_pbl - 10.0)/15., 1.0) + endif acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: @@ -6091,7 +6104,7 @@ SUBROUTINE DMP_mf( & else if ((landsea-1.5).GE.0) then !water: increase factor to compensate for decreased pwmin/pwmax - exc_fac = 0.58*4.0*min(cloud_base/1000., 1.0) + exc_fac = 0.58*4.0 else !land: no need to increase factor - already sufficiently large superadiabatic layers exc_fac = 0.58 From 6d079b8380e0948186e7019644fb38374d31c2fc Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Wed, 25 Oct 2023 20:53:05 -0600 Subject: [PATCH 055/122] Hail diagnostic --- physics/module_mp_thompson.F90 | 102 ++++++++++++------ ...mp_thompson_make_number_concentrations.F90 | 7 +- physics/mp_thompson.F90 | 4 + physics/mp_thompson.meta | 8 ++ 4 files changed, 86 insertions(+), 35 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 271db11d0..d2199bdc6 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -2464,17 +2464,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -3541,17 +3541,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -6085,16 +6085,17 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -6471,6 +6472,43 @@ SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,pfsan,dt,R1) END SUBROUTINE semi_lagrange_sedim +!>\ingroup aathompson +!! @brief Calculates graupel size distribution parameters +!! +!! Calculates graupel intercept and slope parameters for +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] rand1 real random number for stochastic physics +!! @param[in] rg real array, size(kts:kte) for graupel mass concentration [kg m^3] +!! @param[out] ilamg double array, size(kts:kte) for inverse graupel slope parameter [m] +!! @param[out] N0_g double array, size(kts:kte) for graupel intercept paramter [m-4] +subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: rand1 + real, intent(in) :: rg(:) + double precision, intent(out) :: ilamg(:), N0_g(:) + + integer :: k + real :: ygra1, zans1, N0_exp, lam_exp, lamg + + do k = kte, kts, -1 + ygra1 = alog10(max(1.e-9, rg(k))) + zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + N0_exp = 10.**(zans1) + N0_exp = max1(dble(gonv_min), min(N0_exp, dble(gonv_max))) + lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ilamg(k) = 1./lamg + N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + enddo + +end subroutine graupel_psd_parameters + !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ END MODULE module_mp_thompson diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index 72a1055dd..496942f21 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -4,6 +4,7 @@ !>\ingroup aathompson module module_mp_thompson_make_number_concentrations + use machine, only : kind_phys use physcons, only: PI => con_pi implicit none @@ -35,7 +36,7 @@ elemental real function make_IceNumber (Q_ice, temp) !IMPLICIT NONE REAL, PARAMETER:: Ice_density = 890.0 !REAL, PARAMETER:: PI = 3.1415926536 - real, intent(in):: Q_ice, temp + real(kind_phys), intent(in):: Q_ice, temp integer idx_rei real corr, reice, deice double precision lambda @@ -134,7 +135,7 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) !IMPLICIT NONE - real, intent(in):: Q_cloud, qnwfa + real(kind_phys), intent(in):: Q_cloud, qnwfa !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. @@ -173,7 +174,7 @@ elemental real function make_RainNumber (Q_rain, temp) IMPLICIT NONE - real, intent(in):: Q_rain, temp + real(kind_phys), intent(in):: Q_rain, temp double precision:: lambda, N0, qnr !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index c456e87cd..7b5b83b37 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -329,6 +329,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & first_time_step, istep, nsteps, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, fullradar_diag, & + max_hail_diam_sfc, & do_radar_ref, aerfld, & mpicomm, mpirank, mpiroot, blkno, & ext_diag, diag3d, reset_diag3d, & @@ -387,6 +388,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent( out) :: sr(:) ! Radar reflectivity real(kind_phys), intent(inout) :: refl_10cm(:,:) + real(kind_phys), intent(inout) :: max_hail_diam_sfc(:) logical, intent(in ) :: do_radar_ref logical, intent(in) :: sedi_semi integer, intent(in) :: decfl @@ -698,6 +700,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & kme_stoch=kme_stoch, & @@ -738,6 +741,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & rand_perturb_on=spp_mp_opt, kme_stoch=kme_stoch, & rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 5918e4dd9..293dd7625 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -610,6 +610,14 @@ type = real kind = kind_phys intent = out +[max_hail_diam_sfc] + standard_name = max_hail_diameter_sfc + long_name = instantaneous maximum hail diameter at lowest model level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [fullradar_diag] standard_name = do_full_radar_reflectivity long_name = flag for computing full radar reflectivity From ed82327f21b75f0c57562f45c6bce8d3fc25d5f0 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Thu, 26 Oct 2023 10:01:51 -0600 Subject: [PATCH 056/122] Max hail diameter --- physics/module_mp_thompson.F90 | 46 +++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index d2199bdc6..61c07ba29 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -993,6 +993,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod, evapprod, & #endif refl_10cm, diagflag, do_radar_ref, & + max_hail_diam_sfc, & vt_dbz_wt, first_time_step, & re_cloud, re_ice, re_snow, & has_reqc, has_reqi, has_reqs, & @@ -1062,6 +1063,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & GRAUPELNC, GRAUPELNCV REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & refl_10cm + REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & + max_hail_diam_sfc REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & vt_dbz_wt LOGICAL, INTENT(IN) :: first_time_step @@ -1679,6 +1682,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & (nsteps>1 .and. istep==nsteps) .or. & (nsteps==1 .and. ndt==1)) THEN + max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d) + !> - Call calc_refl10cm() diagflag_present: IF ( PRESENT (diagflag) ) THEN @@ -6496,7 +6501,7 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) integer :: k real :: ygra1, zans1, N0_exp, lam_exp, lamg - do k = kte, kts, -1 + do k = kte, kts, -1 ygra1 = alog10(max(1.e-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) @@ -6509,6 +6514,45 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) end subroutine graupel_psd_parameters +!>\ingroup aathompson +!! @brief Calculates graupel/hail maximum diameter +!! +!! Calculates graupel/hail maximum diameter (currently the 99th percentile of mass distribtuion) +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] qg real array, size(kts:kte) for graupel mass mixing ratio [kg kg^-1] +!! @param[in] temperature double array, size(kts:kte) temperature [K] +!! @param[in] pressure double array, size(kts:kte) pressure [Pa] +!! @param[out] max_hail_diam real maximum hail diameter [m] +function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) result(max_hail_diam) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: qg(:), temperature(:), pressure(:), qv(:) + real, intent(out) :: max_hail_diam + + real :: rho(:), rg(:), max_hail_column + real, parameter :: random_number = 0. + + max_hail_column = 0. + rg = 0. + do k = kts, kte + rho(k) = 0.622*pressure(k)/(R*temperature(k)*(max(1.e-10, qv(k))+0.622)) + if (qg(k) .gt. R1) then + rg(k) = qg(k)*rho(k) + endif + enddo + + call graupel_psd_parameters(kts, kte, random_number, rg, ilamg, N0_g) + + where(rg .gt. 1.e-9) max_hail_column = 10.05 * ilamg + max_hail_diam = max_hail_column(kts) + +end function hail_mass_99th_percentile + !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ END MODULE module_mp_thompson From f7edbc1db5595cf58370713a50abdd1ba3bd5eda Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 26 Oct 2023 16:49:24 +0000 Subject: [PATCH 057/122] More cleanup --- physics/CONV/C3/cu_c3_driver.meta | 3 +- physics/CONV/Grell_Freitas/cu_gf_driver.meta | 3 +- .../GFS_phys_time_vary.fv3.meta | 4 +- .../GFS_phys_time_vary.scm.meta | 4 +- .../GFS_surface_composites_post.meta | 2 +- .../GFS_surface_generic_pre.meta | 2 +- .../UFS_SCM_NEPTUNE/sgscloud_radpre.meta | 2 +- physics/MP/Morrison_Gettelman/m_micro.meta | 4 +- physics/NOTUSED/gfs_phy_tracer_config.F | 228 ------------------ physics/NOTUSED/gocart_tracer_config_stub.f | 17 -- physics/NOTUSED/rrtmg_lw_pre.F90 | 26 -- physics/NOTUSED/rrtmg_lw_pre.meta | 24 -- .../RRTMGP/rrtmgp_aerosol_optics.meta | 2 +- physics/Radiation/RRTMGP/rrtmgp_lw_main.meta | 2 +- physics/Radiation/RRTMGP/rrtmgp_sw_main.meta | 2 +- physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta | 5 +- .../GFDL/module_sf_exchcoef.f90 | 0 physics/SFC_Layer/MYJ/myjsfc_wrapper.meta | 2 +- physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta | 2 +- physics/SFC_Layer/UFS/sfc_diag.meta | 2 +- physics/SFC_Models/Lake/CLM/clm_lake.meta | 2 +- .../SFC_Models/Lake/Flake/flake_driver.meta | 2 +- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 +- physics/SFC_Models/Land/RUC/lsm_ruc.meta | 3 +- physics/SFC_Models/Ocean/UFS/sfc_ocean.meta | 2 +- physics/SFC_Models/SeaIce/CICE/sfc_cice.meta | 2 +- physics/SFC_Models/SeaIce/CICE/sfc_sice.meta | 2 +- physics/{h2o_photo => photochem}/h2o_def.f | 0 physics/{h2o_photo => photochem}/h2o_def.meta | 0 .../{h2o_photo => photochem}/h2ointerp.f90 | 0 physics/{h2o_photo => photochem}/h2ophys.f | 0 physics/{h2o_photo => photochem}/h2ophys.meta | 2 +- physics/{o3_photo => photochem}/ozinterp.f90 | 0 physics/{o3_photo => photochem}/ozne_def.f | 0 physics/{o3_photo => photochem}/ozne_def.meta | 0 physics/{o3_photo => photochem}/ozphys.f | 0 physics/{o3_photo => photochem}/ozphys.meta | 2 +- physics/{o3_photo => photochem}/ozphys_2015.f | 0 .../{o3_photo => photochem}/ozphys_2015.meta | 2 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.meta | 2 +- 42 files changed, 38 insertions(+), 326 deletions(-) delete mode 100644 physics/NOTUSED/gfs_phy_tracer_config.F delete mode 100644 physics/NOTUSED/gocart_tracer_config_stub.f delete mode 100644 physics/NOTUSED/rrtmg_lw_pre.F90 delete mode 100644 physics/NOTUSED/rrtmg_lw_pre.meta rename physics/{MP => SFC_Layer}/GFDL/module_sf_exchcoef.f90 (100%) rename physics/{h2o_photo => photochem}/h2o_def.f (100%) rename physics/{h2o_photo => photochem}/h2o_def.meta (100%) rename physics/{h2o_photo => photochem}/h2ointerp.f90 (100%) rename physics/{h2o_photo => photochem}/h2ophys.f (100%) rename physics/{h2o_photo => photochem}/h2ophys.meta (98%) rename physics/{o3_photo => photochem}/ozinterp.f90 (100%) rename physics/{o3_photo => photochem}/ozne_def.f (100%) rename physics/{o3_photo => photochem}/ozne_def.meta (100%) rename physics/{o3_photo => photochem}/ozphys.f (100%) rename physics/{o3_photo => photochem}/ozphys.meta (99%) rename physics/{o3_photo => photochem}/ozphys_2015.f (100%) rename physics/{o3_photo => photochem}/ozphys_2015.meta (99%) diff --git a/physics/CONV/C3/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta index bb2784642..da3ccc6dd 100644 --- a/physics/CONV/C3/cu_c3_driver.meta +++ b/physics/CONV/C3/cu_c3_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_c3_driver type = scheme - dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90,../progsigma_calc.f90 + dependencies = ../../hooks/machine.F + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index db2973c0f..87add2809 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_gf_driver type = scheme - dependencies = cu_gf_deep.F90,cu_gf_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../hooks/machine.F + dependencies = cu_gf_deep.F90,cu_gf_sh.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 7df4cf715..8a35d469c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -8,8 +8,8 @@ dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f - dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = photochem/ozinterp.f90,photochem/ozne_def.f + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index e1de4d699..86c052b0e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -7,8 +7,8 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f - dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = photochem/ozinterp.f90,photochem/ozne_def.f + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index 35b54544a..7224d7221 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -3,7 +3,7 @@ name = GFS_surface_composites_post type = scheme relative_path = ../../ - dependencies = hooks/machine.F,SFC_Layer/GFS_sfc/sfc_diff.f + dependencies = hooks/machine.F,SFC_Layer/UFS/sfc_diff.f ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index 63fb9b96c..bbf7dd5c3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -2,7 +2,7 @@ name = GFS_surface_generic_pre type = scheme relative_path = ../../ - dependencies = hooks/machine.F,Land/Noah/surface_perturbation.F90 + dependencies = hooks/machine.F,SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index 9829e3538..a9635efa5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -2,7 +2,7 @@ name = sgscloud_radpre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 diff --git a/physics/MP/Morrison_Gettelman/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta index 4b6df18c7..16efc5cc4 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F + dependencies = micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] diff --git a/physics/NOTUSED/gfs_phy_tracer_config.F b/physics/NOTUSED/gfs_phy_tracer_config.F deleted file mode 100644 index 647919a23..000000000 --- a/physics/NOTUSED/gfs_phy_tracer_config.F +++ /dev/null @@ -1,228 +0,0 @@ - -! -!! ! Module: gfs_phy_tracer_config -! -! ! Description: gfs physics tracer configuration module -! -! ! Revision history: -! Oct 16 2009 Sarah Lu, adopted from dyn fc -! Nov 21 2009 Sarah Lu, chem tracer specified from ChemRegistry -! Dec 10 2009 Sarah Lu, add doing_GOCART -! Jan 12 2010 Sarah Lu, add trcindx -! Feb 08 2009 Sarah Lu, ri/cpi added to gfs_phy_tracer_type -! Aug 17 2010 Sarah Lu, remove debug print -! Oct 16 2010 Sarah Lu, add fscav -! Aug 08 2011 Jun Wang, remove gocart dependency when not running GOCART -! Sep 17 2011 Sarah Lu, revise chem tracer initialization -! Nov 11 2011 Sarah Lu, allocate but not assign value for cpi/ri array -! Apr 06 2012 Henry Juang, relax hardwire num_tracer, add tracer 4 and 5 -! Apr 23 2012 Jun Wang, remove save attibute for gfs_phy_tracer (already defined) -! --- -- 2016 Anning Cheng add ntiw,ntlnc,ntinc -! May 03 2016 S Moorthi add nto, nto2 -! ------------------------------------------------------------------------- -! - module gfs_phy_tracer_config - use machine , only : kind_phys - - implicit none - SAVE -! -! tracer specification: add fscav -! - type gfs_phy_tracer_type - character*20 , pointer :: chem_name(:) ! chem_tracer name - character*20 , pointer :: vname(:) ! variable name - real(kind=kind_phys), pointer :: ri(:) - real(kind=kind_phys), pointer :: cpi(:) - real(kind=kind_phys), pointer :: fscav(:) - integer :: ntrac, ntrac_met, ntrac_chem - logical :: doing_DU, doing_SU, doing_SS - &, doing_OC, doing_BC, doing_GOCART - endtype gfs_phy_tracer_type - - type (gfs_phy_tracer_type) :: gfs_phy_tracer -! -! misc tracer options -! - logical :: glbsum = .true. -! - -! --- public interface - public tracer_config_init, trcindx - - contains - -! ------------------------------------------------------------------- -! ------------------------------------------------------------------- -! subroutine tracer_config_init (gfs_phy_tracer,ntrac, - subroutine tracer_config_init (ntrac,ntoz,ntcw,ncld, - & ntiw,ntlnc,ntinc, - & fprcp,ntrw,ntsw,ntrnc,ntsnc, - & ntke,nto,nto2,me) - -c -c This subprogram sets up gfs_phy_tracer -c - implicit none -! input - integer, intent(in) :: me, ntoz,ntcw,ntke, - & ntiw,ntlnc,ntinc,nto,nto2, - & fprcp,ntrw,ntsw,ntrnc,ntsnc -! output -! type (gfs_phy_tracer_type), intent(out) :: gfs_phy_tracer -! input/output - integer, intent(inout) :: ntrac -! local - integer :: i, j, status, ierr - character*20 :: rgname - -! initialize ntrac_chem (the default is no chemistry) - gfs_phy_tracer%ntrac_chem = 0 - gfs_phy_tracer%doing_GOCART = .false. - -! initialize chem tracers - call gocart_tracer_config(me) - -! input ntrac is meteorological tracers - gfs_phy_tracer%ntrac_met = ntrac - -! update ntrac = total number of tracers - gfs_phy_tracer%ntrac = gfs_phy_tracer%ntrac_met + - & gfs_phy_tracer%ntrac_chem - ntrac = gfs_phy_tracer%ntrac - - if(me==0) then - print *, 'LU_TRCp: ntrac_met =',gfs_phy_tracer%ntrac_met - print *, 'LU_TRCp: ntrac_chem=',gfs_phy_tracer%ntrac_chem - print *, 'LU_TRCp: ntrac =',gfs_phy_tracer%ntrac - endif - -! Set up tracer name, cpi, and ri - if ( gfs_phy_tracer%ntrac > 0 ) then - allocate(gfs_phy_tracer%vname(ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%ri(0:ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%cpi(0:ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%fscav(ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - -!--- fill in met tracers - gfs_phy_tracer%vname(1) = 'spfh' - if(ntcw > 0) gfs_phy_tracer%vname(ntcw) = 'clwmr' - if(ntiw > 0) gfs_phy_tracer%vname(ntiw) = 'climr' - if(ntlnc > 0) gfs_phy_tracer%vname(ntlnc) = 'lnc' - if(ntinc > 0) gfs_phy_tracer%vname(ntinc) = 'inc' - if(ntrw > 0) gfs_phy_tracer%vname(ntrw) = 'rnmr' - if(ntsw > 0) gfs_phy_tracer%vname(ntsw) = 'snwmr' - if(ntrnc > 0) gfs_phy_tracer%vname(ntrnc) = 'rnc' - if(ntsnc > 0) gfs_phy_tracer%vname(ntsnc) = 'snc' - if(ntke > 0) gfs_phy_tracer%vname(ntke) = 'tke' -#ifdef MULTI_GASES - print *,' ++++ ntoz nto nto2 ',ntoz,nto,nto2 - if(ntoz > 0) gfs_phy_tracer%vname(ntoz) = 'spo3' - if(nto > 0) gfs_phy_tracer%vname(nto) = 'spo' - if(nto2 > 0) gfs_phy_tracer%vname(nto2) = 'spo2' -#else - if(ntoz > 0) gfs_phy_tracer%vname(ntoz) = 'o3mr' - if(nto > 0) gfs_phy_tracer%vname(nto) = 'o' - if(nto2 > 0) gfs_phy_tracer%vname(nto2) = 'o2' -#endif - - - gfs_phy_tracer%fscav(1:gfs_phy_tracer%ntrac_met) = 0. - -!--- fill in chem tracers - if ( gfs_phy_tracer%ntrac_chem > 0 ) then - do i = 1,gfs_phy_tracer%ntrac_chem - j = i + gfs_phy_tracer%ntrac_met - rgname = trim(gfs_phy_tracer%chem_name(i)) - if(me==0)print *, 'LU_TRC_phy: vname=',j,rgname - gfs_phy_tracer%vname(j) = rgname - enddo - endif - - endif !! - - return - - end subroutine tracer_config_init -! ------------------------------------------------------------------- -! ------------------------------------------------------------------- - function trcindx( specname, tracer ) - implicit none - - character*(*), intent(in) :: specname - type (gfs_phy_tracer_type), intent(in) :: tracer - - character*10 :: name1, name2 - integer :: i, trcindx - -! -- set default value - trcindx = -999 - -! -- convert specname to upper case - call fixchar(specname, name1, 1) - do i = 1, tracer%ntrac - call fixchar(tracer%vname(i), name2, 1) - if( name1 == name2 ) then - trcindx = i - exit - endif - enddo - - return - end function trcindx - -! ------------------------------------------------------------------- - subroutine fixchar(name_in, name_out, option) - implicit none - - character*(*), intent(in) :: name_in - character*(*), intent(out) :: name_out - integer, intent(in) :: option - - character*10 :: temp - integer :: i, ic - - name_out= ' ' - temp = trim(adjustl(name_in)) - do i = 1, len_trim(temp) - ic = IACHAR(temp(i:i)) - if(option == 1 ) then !<--- convert to upper case - if(ic .ge. 97 .and. ic .le. 122) then - name_out(i:i) = CHAR( IC-32 ) - else - name_out(i:i) = temp(i:i) - endif - endif - if(option == 2 ) then !<--- convert to lower case - if(ic .ge. 65 .and. ic .le. 90) then - name_out(i:i) = CHAR( IC+32 ) - else - name_out(i:i) = temp(i:i) - endif - endif - - enddo - name_out = trim(name_out) - return - - end subroutine fixchar - -! ========================================================================= - - end module gfs_phy_tracer_config diff --git a/physics/NOTUSED/gocart_tracer_config_stub.f b/physics/NOTUSED/gocart_tracer_config_stub.f deleted file mode 100644 index d6df297c7..000000000 --- a/physics/NOTUSED/gocart_tracer_config_stub.f +++ /dev/null @@ -1,17 +0,0 @@ -! -!! ! Subroutine : gocart_tracer_config -! -! ! Description: stub for resetting gfs phys when gocart is running -! -! ! Revision history: -! Aug 09 2011 Jun Wang, initial code -! ------------------------------------------------------------------------- -! - subroutine gocart_tracer_config() -! - -! print *,'TRAC_CONFIG: gocart is not running.' - - return - - end subroutine gocart_tracer_config diff --git a/physics/NOTUSED/rrtmg_lw_pre.F90 b/physics/NOTUSED/rrtmg_lw_pre.F90 deleted file mode 100644 index 2b63d98c5..000000000 --- a/physics/NOTUSED/rrtmg_lw_pre.F90 +++ /dev/null @@ -1,26 +0,0 @@ -!>\file rrtmg_lw_pre.F90 -!! - module rrtmg_lw_pre - contains - -!>\defgroup rrtmg_lw_pre GFS RRTMG-LW scheme pre -!! This module contains RRTMG-LW pre module. -!> @{ -!> \section arg_table_rrtmg_lw_pre_run Argument Table -!! \htmlinclude rrtmg_lw_pre_run.html -!! - subroutine rrtmg_lw_pre_run (errmsg, errflg) - - implicit none - - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine rrtmg_lw_pre_run - -!> @} - end module rrtmg_lw_pre diff --git a/physics/NOTUSED/rrtmg_lw_pre.meta b/physics/NOTUSED/rrtmg_lw_pre.meta deleted file mode 100644 index 9f6ec07c8..000000000 --- a/physics/NOTUSED/rrtmg_lw_pre.meta +++ /dev/null @@ -1,24 +0,0 @@ -[ccpp-table-properties] - name = rrtmg_lw_pre - type = scheme - dependencies = - -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_pre_run - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta index 0847877d6..37ec2e9a0 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_aerosol_optics type = scheme - dependencies = ../iounitdef.f,../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 + dependencies = ../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 011376985..779389581 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -7,7 +7,7 @@ dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 - dependencies = ../../GFS/GFS_rrtmgp_pre.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index 932e2195e..711d01bc1 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -7,7 +7,7 @@ dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 - dependencies = ../../GFS/GFS_rrtmgp_pre.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index b0d613eed..ac98437e9 100644 --- a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - relative_path = ../../ - dependencies = hooks/machine.F,SFC_Layer/module_sf_exchcoef.f90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90,Land/Noahmp/noahmp_tables.f90 + dependencies = ../../hooks/machine.F,module_sf_exchcoef.f90 + dependencies = ../../SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 + dependencies = ../../SFC_Models/Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/GFDL/module_sf_exchcoef.f90 b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 similarity index 100% rename from physics/MP/GFDL/module_sf_exchcoef.f90 rename to physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 9805db619..0ae09985e 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjsfc_wrapper type = scheme - dependencies = ../../hooks/machine.f,module_SF_JSFC.F90 + dependencies = ../../hooks/machine.F,module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index a76df3790..0e1c96c02 100644 --- a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnsfc_wrapper type = scheme - dependencies = ../../hooks/machine.F,module_sf_mynn.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index 6a82c2c61..f4f83ab04 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -2,7 +2,7 @@ name = sfc_diag type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta index 3a519244a..a02aee9c6 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.meta +++ b/physics/SFC_Models/Lake/CLM/clm_lake.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = clm_lake type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Lake/Flake/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta index 8b295bc27..22ab62d1e 100644 --- a/physics/SFC_Models/Lake/Flake/flake_driver.meta +++ b/physics/SFC_Models/Lake/Flake/flake_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = flake_driver type = scheme - dependencies = ../../hooks/machine.F,flake.F90 + dependencies = ../../../hooks/machine.F,flake.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 2dc612d5b..07f4045a2 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = lsm_noah type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 55a787cd7..e7a73ef99 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta index f02d6de67..c05eb30e8 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = ../../hooks/machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 + dependencies = ../../../hooks/machine.F,../../../hooks/physcons.F90 + dependencies = module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index ea575a071..848c2e3ed 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_ocean type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta index 52fa28a3d..c44f9d6b5 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_cice type = scheme - relative_path = ../../ + relative_path = ../../../ dependencies = hooks/machine.F ######################################################################## diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta index 7277c0511..828a83939 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_sice type = scheme - relative_path = ../../ + relative_path = ../../../ dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## diff --git a/physics/h2o_photo/h2o_def.f b/physics/photochem/h2o_def.f similarity index 100% rename from physics/h2o_photo/h2o_def.f rename to physics/photochem/h2o_def.f diff --git a/physics/h2o_photo/h2o_def.meta b/physics/photochem/h2o_def.meta similarity index 100% rename from physics/h2o_photo/h2o_def.meta rename to physics/photochem/h2o_def.meta diff --git a/physics/h2o_photo/h2ointerp.f90 b/physics/photochem/h2ointerp.f90 similarity index 100% rename from physics/h2o_photo/h2ointerp.f90 rename to physics/photochem/h2ointerp.f90 diff --git a/physics/h2o_photo/h2ophys.f b/physics/photochem/h2ophys.f similarity index 100% rename from physics/h2o_photo/h2ophys.f rename to physics/photochem/h2ophys.f diff --git a/physics/h2o_photo/h2ophys.meta b/physics/photochem/h2ophys.meta similarity index 98% rename from physics/h2o_photo/h2ophys.meta rename to physics/photochem/h2ophys.meta index d8a9eabab..9e9b03647 100644 --- a/physics/h2o_photo/h2ophys.meta +++ b/physics/photochem/h2ophys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2ophys type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/o3_photo/ozinterp.f90 b/physics/photochem/ozinterp.f90 similarity index 100% rename from physics/o3_photo/ozinterp.f90 rename to physics/photochem/ozinterp.f90 diff --git a/physics/o3_photo/ozne_def.f b/physics/photochem/ozne_def.f similarity index 100% rename from physics/o3_photo/ozne_def.f rename to physics/photochem/ozne_def.f diff --git a/physics/o3_photo/ozne_def.meta b/physics/photochem/ozne_def.meta similarity index 100% rename from physics/o3_photo/ozne_def.meta rename to physics/photochem/ozne_def.meta diff --git a/physics/o3_photo/ozphys.f b/physics/photochem/ozphys.f similarity index 100% rename from physics/o3_photo/ozphys.f rename to physics/photochem/ozphys.f diff --git a/physics/o3_photo/ozphys.meta b/physics/photochem/ozphys.meta similarity index 99% rename from physics/o3_photo/ozphys.meta rename to physics/photochem/ozphys.meta index 631dcb332..a1f7e4eb2 100644 --- a/physics/o3_photo/ozphys.meta +++ b/physics/photochem/ozphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/o3_photo/ozphys_2015.f b/physics/photochem/ozphys_2015.f similarity index 100% rename from physics/o3_photo/ozphys_2015.f rename to physics/photochem/ozphys_2015.f diff --git a/physics/o3_photo/ozphys_2015.meta b/physics/photochem/ozphys_2015.meta similarity index 99% rename from physics/o3_photo/ozphys_2015.meta rename to physics/photochem/ozphys_2015.meta index 7da8cdf27..632dbc340 100644 --- a/physics/o3_photo/ozphys_2015.meta +++ b/physics/photochem/ozphys_2015.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys_2015 type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 339f6ca03..e65d182d3 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index b084cdd66..b079b12c9 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = ../hooks/machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 ######################################################################## [ccpp-arg-table] From 81563de9686260bc5f1c85fe350d48e56fdf7afc Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 26 Oct 2023 19:17:33 +0000 Subject: [PATCH 058/122] move setting of flag from run to init phase --- physics/cu_c3_driver.F90 | 26 ++++++++++++++------------ physics/cu_c3_driver.meta | 21 ++++++++++++++------- 2 files changed, 28 insertions(+), 19 deletions(-) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 5b6be1d6c..c911ff5e4 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -30,7 +30,8 @@ module cu_c3_driver !! \htmlinclude cu_c3_driver_init.html !! subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & - imfdeepcnv_c3,mpirank, mpiroot, errmsg, errflg) + imfdeepcnv_c3,progsigma, cnx, mpirank, mpiroot, & + errmsg, errflg) implicit none @@ -38,6 +39,8 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & integer, intent(in) :: imfdeepcnv, imfdeepcnv_c3 integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: cnx + logical, intent(inout) :: progsigma character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -45,6 +48,13 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & errmsg = '' errflg = 0 + if(progsigma)then + if(cnx < 384)then + progsigma=.false. + write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' + endif + endif + end subroutine cu_c3_driver_init ! @@ -58,7 +68,7 @@ end subroutine cu_c3_driver_init !! !>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& - do_ca,progsigma,cnx,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & + do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & qv2di_spechum,p2di,psuri, & @@ -93,14 +103,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer,cnx + integer, intent(in ) :: im,km,ntracer integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & do_ca real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d - logical, intent(inout) :: progsigma + logical, intent(in ) :: progsigma real(kind=kind_phys), intent(inout) :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & @@ -280,14 +290,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc end kernels endif - - if(progsigma)then - if(cnx < 384)then - progsigma=.false. - write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' - endif - endif - if(ldiag3d) then if(flag_for_dcnv_generic_tend) then cliw_deep_idx=0 diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index 71a785318..801b1e9d7 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -49,6 +49,20 @@ dimensions = () type = integer intent = in +[progsigma] + standard_name = do_prognostic_updraft_area_fraction + long_name = flag for prognostic sigma in cumuls scheme + units = flag + dimensions = () + type = logical + intent = inout +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -133,13 +147,6 @@ units = flag dimensions = () type = logical - intent = inout -[cnx] - standard_name = number_of_x_points_for_current_cubed_sphere_tile - long_name = number of points in x direction for this cubed sphere face - units = count - dimensions = () - type = integer intent = in [cactiv] standard_name = counter_for_grell_freitas_convection From e861277c1ffe8fdcb1b026240f98077bb7a91473 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Thu, 26 Oct 2023 21:10:37 +0000 Subject: [PATCH 059/122] address review comments --- physics/cu_c3_sh.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cu_c3_sh.F90 b/physics/cu_c3_sh.F90 index 704f2a0fc..736292092 100644 --- a/physics/cu_c3_sh.F90 +++ b/physics/cu_c3_sh.F90 @@ -676,7 +676,7 @@ subroutine cu_c3_sh_run ( & dz=z_cup(i,k)-z_cup(i,k-1) ! cloud liquid water c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1) - clw_all(i,k)=max(0.,qco(i,k)-trash) + clw_all(i,k)=max(0._kind_phys,qco(i,k)-trash) qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz) if(qrco(i,k).lt.0.)then ! hli new test 02/12/19 qrco(i,k)=0. From 1000af768a289c9a139f92a7d50c7a56bd2de5c9 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 27 Oct 2023 18:21:27 +0000 Subject: [PATCH 060/122] Fixes after debug --- physics/module_mp_thompson.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 61c07ba29..9f81bb3f3 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1682,7 +1682,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & (nsteps>1 .and. istep==nsteps) .or. & (nsteps==1 .and. ndt==1)) THEN - max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d) + max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d, qv1d) !> - Call calc_refl10cm() @@ -6525,6 +6525,7 @@ end subroutine graupel_psd_parameters !! @param[in] qg real array, size(kts:kte) for graupel mass mixing ratio [kg kg^-1] !! @param[in] temperature double array, size(kts:kte) temperature [K] !! @param[in] pressure double array, size(kts:kte) pressure [Pa] +!! @param[in] qv real array, size(kts:kte) water vapor mixing ratio [kg kg^-1] !! @param[out] max_hail_diam real maximum hail diameter [m] function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) result(max_hail_diam) @@ -6532,9 +6533,11 @@ function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) resu integer, intent(in) :: kts, kte real, intent(in) :: qg(:), temperature(:), pressure(:), qv(:) - real, intent(out) :: max_hail_diam + real :: max_hail_diam - real :: rho(:), rg(:), max_hail_column + integer :: k + real :: rho(kts:kte), rg(kts:kte), max_hail_column(kts:kte) + double precision :: ilamg(kts:kte), N0_g(kts:kte) real, parameter :: random_number = 0. max_hail_column = 0. From ddf6a5ca1a740f79cd8c58f8ecf84d47f0f4905d Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 27 Oct 2023 18:29:56 +0000 Subject: [PATCH 061/122] real to double for graupel psd parameters --- physics/module_mp_thompson.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 9f81bb3f3..211a044c9 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -6499,7 +6499,8 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) double precision, intent(out) :: ilamg(:), N0_g(:) integer :: k - real :: ygra1, zans1, N0_exp, lam_exp, lamg + real :: ygra1, zans1 + double precision :: N0_exp, lam_exp, lamg do k = kte, kts, -1 ygra1 = alog10(max(1.e-9, rg(k))) From dbfd4e639334271831b1c260fdceb116a93d8bf6 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 27 Oct 2023 23:06:11 +0000 Subject: [PATCH 062/122] Updating snow cloud fractions in MYNN-EDMF and removing redundant logic in sgscloud_radpre.F90 --- physics/module_bl_mynn.F90 | 26 ++++++++++++++------------ physics/mynnedmf_wrapper.F90 | 28 +++++++++++++++------------- physics/sgscloud_radpre.F90 | 6 +++--- 3 files changed, 32 insertions(+), 28 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index f520ae171..a2ba17c65 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -519,7 +519,7 @@ SUBROUTINE mynn_bl_driver( & real(kind_phys), dimension(kts:kte) :: & &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & - &vt, vq, sgm + &vt, vq, sgm, kzero real(kind_phys), dimension(kts:kte) :: & &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & @@ -635,6 +635,7 @@ SUBROUTINE mynn_bl_driver( & maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. + kzero(kts:kte)=0. ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS !> - Within the MYNN-EDMF, there is a dependecy check for the first time step, @@ -743,7 +744,7 @@ SUBROUTINE mynn_bl_driver( & !keep snow out for now - increases ceiling bias sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -990,10 +991,10 @@ SUBROUTINE mynn_bl_driver( & else zw(k)=zw(k-1)+dz(i,k-1) endif - !keep snow out for now - increases ceiling bias + !keep snow out for now - increases ceiling bias sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -1223,9 +1224,9 @@ SUBROUTINE mynn_bl_driver( & call mynn_tendencies(kts,kte,i, & &delt, dz1, rho1, & &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qs1, qnc1, qni1, & + &qc1, qi1, kzero, qnc1, qni1, & !kzero replaces qs1 - not mixing snow &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqs, sqw, & + &sqv, sqc, sqi, kzero, sqw, & !kzero replaces sqs - not mixing snow &qnwfa1, qnifa1, qnbca1, ozone1, & &ust(i),flt,flq,flqv,flqc, & &wspd(i),uoce(i),voce(i), & @@ -3850,11 +3851,11 @@ SUBROUTINE mym_condensation (kts,kte, & q1(k) = qmq / sgm(k) ! Q1, the normalized saturation !Add condition for falling/settling into low-RH layers, so at least - !some cloud fraction is applied for all qc and qi. + !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then - rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) + rh_hack =min(1.0, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3869,8 +3870,8 @@ SUBROUTINE mym_condensation (kts,kte, & q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) - if (qs(k)>1.e-7 .and. zagl .gt. pblh2) then - rh_hack =min(1.0, rhcrit + 0.08*(7.0 + log10(qs(k)))) + if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then + rh_hack =min(1.0, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -4614,7 +4615,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !============================================ ! MIX SNOW ( sqs ) !============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QS) THEN +!hard-code to not mix snow +IF (bl_mynn_cloudmix > 0 .AND. .false.) THEN k=kts !rho-weighted: @@ -4981,7 +4983,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== ! CLOUD SNOW TENDENCY !=================== - IF (FLAG_QS) THEN + IF (.false.) THEN !disabled DO k=kts,kte Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt ENDDO diff --git a/physics/mynnedmf_wrapper.F90 b/physics/mynnedmf_wrapper.F90 index 46db1c441..487753027 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/mynnedmf_wrapper.F90 @@ -326,6 +326,7 @@ SUBROUTINE mynnedmf_wrapper_run( & integer :: idtend real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 real(kind_phys), allocatable :: save_qke_adv(:,:) + real(kind_phys), dimension(levs) :: kzero ! Initialize CCPP error handling variables errmsg = '' @@ -356,6 +357,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif + kzero = zero !generic zero array !initialize arrays for test EMIS_ANT_NO = 0. @@ -392,7 +394,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .true. FLAG_QC = .true. FLAG_QNC= .true. - FLAG_QS = .false. !.true. + FLAG_QS = .true. FLAG_QNWFA= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field? FLAG_QNIFA= .false. FLAG_QNBCA= .false. @@ -401,7 +403,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0.0 !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) @@ -419,7 +421,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. !pipe it in, but do not mix FLAG_QNC= .true. FLAG_QNWFA= .true. FLAG_QNIFA= .true. @@ -429,7 +431,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -442,7 +444,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .true. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -452,7 +454,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -465,7 +467,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -475,7 +477,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -566,7 +568,7 @@ SUBROUTINE mynnedmf_wrapper_run( & call moisture_check2(levs, delt, & delp(i,:), exner(i,:), & sqv(i,:), sqc(i,:), & - sqi(i,:), sqs(i,:), & + sqi(i,:), kzero(:), & t3d(i,:) ) enddo @@ -835,7 +837,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) @@ -870,7 +872,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) enddo enddo if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then @@ -888,7 +890,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -918,7 +920,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - !dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) IF ( nssl_ccn_on ) THEN ! dqdt_cccn(i,k) = RQNWFABLTEN(i,k) ENDIF diff --git a/physics/sgscloud_radpre.F90 b/physics/sgscloud_radpre.F90 index 44ab87bcc..936393d5b 100644 --- a/physics/sgscloud_radpre.F90 +++ b/physics/sgscloud_radpre.F90 @@ -216,10 +216,10 @@ subroutine sgscloud_radpre_run( & qi(i,k) = ice_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) !iwc = qi(i,k)*1.0e6*rho(i,k) - !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + !clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) !calculate the ice water path using additional BL clouds clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) @@ -229,7 +229,7 @@ subroutine sgscloud_radpre_run( & qs(i,k) = snow_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qs(i,k)>1.E-8)clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) + clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) !calculate the snow water path using additional BL clouds clouds8(i,k) = max(0.0, qs(i,k) * gfac * delp(i,k)) From 872f48820b8194275268b5d6add33cf0e7731025 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:25:12 +0000 Subject: [PATCH 063/122] Addressing comments from Dustin --- physics/module_sf_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index c2845f290..048a5c696 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -1381,7 +1381,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ZNTstoch_lnd(I) = ZNT_lnd(I) endif !add limit to prevent ridiculous values of z0 (more than dz/15) - ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666) + ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666_kind_phys) !-------------------------------------- ! LAND From 277bd480032dfa3ab518f12e17cd145d8590ebce Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:26:23 +0000 Subject: [PATCH 064/122] Addressing comments from Dustin --- physics/module_bl_mynn.F90 | 53 +++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index a2ba17c65..4b47b43a7 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3046,7 +3046,6 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & -!fix? & TKEprodTD(k) & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) @@ -3091,7 +3090,6 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now -!fix? qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen !!!Dissipation Term (now it evaluated in mym_predict) @@ -3801,7 +3799,7 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - pblh2=MAX(10.,pblh1) + pblh2=MAX(10._kind_phys,pblh1) zagl = 0. dzm1 = 0. DO k = kts,kte-1 @@ -3811,7 +3809,7 @@ SUBROUTINE mym_condensation (kts,kte, & t = th(k)*exner(k) xl = xl_blend(t) ! obtain latent heat qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k) = MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) + rh(k) = MAX(MIN(1.0_kind_phys,qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) @@ -3840,7 +3838,7 @@ SUBROUTINE mym_condensation (kts,kte, & !sgm(k) = max( sgm(k), qsat_tk*0.035 ) !introduce vertical grid spacing dependence on min sgm - wt = max(500. - max(dz(k)-100.,0.0), 0.0)/500. !=1 for dz < 100 m, =0 for dz > 600 m + wt = max(500. - max(dz(k)-100.,0.0), 0.0_kind_phys)/500. !=1 for dz < 100 m, =0 for dz > 600 m sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz !allow min sgm to vary with dz and z. @@ -3855,7 +3853,7 @@ SUBROUTINE mym_condensation (kts,kte, & rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then - rh_hack =min(1.0, rhcrit + 0.07*(9.0 + log10(qi(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3863,7 +3861,7 @@ SUBROUTINE mym_condensation (kts,kte, & endif !ensure adequate RH & q1 when qc is at least 1e-6 if (qc(k)>1.e-6) then - rh_hack =min(1.0, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.09*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3871,7 +3869,7 @@ SUBROUTINE mym_condensation (kts,kte, & endif !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(1.0, rhcrit + 0.07*(8.0 + log10(qs(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3953,10 +3951,10 @@ SUBROUTINE mym_condensation (kts,kte, & elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then Fng = 3.0 + exp(-3.8*(q1k+1.7)) else - Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60.) + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60._kind_phys) endif - cfmax = min(cldfra_bl1D(k), 0.6) + cfmax = min(cldfra_bl1D(k), 0.6_kind_phys) !Further limit the cf going into vt & vq near the surface zsl = min(max(25., 0.1*pblh2), 100.) wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer @@ -4921,9 +4919,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2(k) = 0.0 ! if sqw2 > qsat sqc2(k) = 0.0 ENDIF - !dqv(k) = (sqv2(k) - sqv(k))/delt - !dqc(k) = (sqc2(k) - sqc(k))/delt - !dqi(k) = (sqi2(k) - sqi(k))/delt ENDDO ENDIF @@ -4932,7 +4927,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + Dqv(k)=(sqv2(k) - sqv(k))/delt !if (sqv2(k) < 0.0)print*,"neg qv:",sqv2(k),k ENDDO @@ -4943,7 +4938,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt + Dqc(k)=(sqc2(k) - sqc(k))/delt !if (sqc2(k) < 0.0)print*,"neg qc:",sqc2(k),k ENDDO ELSE @@ -4971,7 +4966,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt + Dqi(k)=(sqi2(k) - sqi(k))/delt !if (sqi2(k) < 0.0)print*,"neg qi:",sqi2(k),k ENDDO ELSE @@ -4985,7 +4980,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (.false.) THEN !disabled DO k=kts,kte - Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt + Dqs(k)=(sqs2(k) - sqs(k))/delt ENDDO ELSE DO k=kts,kte @@ -5009,10 +5004,11 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ELSE !-MIX CLOUD SPECIES? !CLOUDS ARE NOT NIXED (when bl_mynn_cloudmix == 0) DO k=kts,kte - Dqc(k)=0. + Dqc(k) =0. Dqnc(k)=0. - Dqi(k)=0. + Dqi(k) =0. Dqni(k)=0. + Dqs(k) =0. ENDDO ENDIF @@ -6007,30 +6003,27 @@ SUBROUTINE DMP_mf( & ! Criteria (1) maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = min(maxwidth, 1.1*PBLH) + maxwidth = min(maxwidth, 1.1_kind_phys*PBLH) ! Criteria (3) if ((landsea-1.5) .lt. 0) then !land - maxwidth = MIN(maxwidth, 0.5*cloud_base) + maxwidth = MIN(maxwidth, 0.5_kind_phys*cloud_base) else !water - maxwidth = MIN(maxwidth, 0.9*cloud_base) + maxwidth = MIN(maxwidth, 0.9_kind_phys*cloud_base) endif ! Criteria (4) - wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01_kind_phys)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000._kind_phys), 0._kind_phys) else !water - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000._kind_phys), 0._kind_phys) endif maxwidth = MIN(maxwidth, width_flx) minwidth = lmin !allow min plume size to increase in large flux conditions (eddy diffusivity should be !large enough to handle the representation of small plumes). - if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1.) + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1._kind_phys) if (maxwidth .le. minwidth) then ! deactivate MF component nup2 = 0 @@ -6048,7 +6041,7 @@ SUBROUTINE DMP_mf( & ! Find coef C for number size density N cn = 0. d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). - dl = (maxwidth - minwidth)/real(nup-1) + dl = (maxwidth - minwidth)/real(nup-1,kind=kind_phys) do i=1,NUP ! diameter of plume l = minwidth + dl*real(i-1) From b2dc0bf4eb3de74c43cf447ecac18578a4587167 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:51:30 +0000 Subject: [PATCH 065/122] Adding some comments to describe overall changes. --- physics/module_bl_mynn.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 4b47b43a7..a636a4fe8 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -232,6 +232,18 @@ ! bl_mynn_cloudpdf = 2 (Chab-Becht). ! Removed WRF_CHEM dependencies. ! Many miscellaneous tweaks. +! v4.5.2 / CCPP +! Some code optimization. Removed many conditions from loops. Redesigned the mass- +! flux scheme to use 8 plumes instead of a variable n plumes. This results in +! the removal of the output variable "nudprafts" and adds maxwidth and ztop_plume. +! Revision option bl_mynn_cloudpdf = 2, which now ensures cloud fractions for all +! optically relevant mixing ratios (tip from Greg Thompson). Also, added flexibility +! for tuning near-surface cloud fractions to remove excess fog/low ceilings. +! Now outputs all SGS cloud mixing ratios as grid-mean values, not in-cloud. This +! results in a change in the pre-radiation code to no longer multiply mixing ratios +! by cloud fractions. +! Lots of code cleanup: removal of test code, comments, changing text case, etc. +! Many misc tuning/tweaks. ! ! Many of these changes are now documented in references listed above. !==================================================================== From 5658192be2595309ba44e258c86d831275149991 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 30 Oct 2023 19:12:02 +0000 Subject: [PATCH 066/122] fix typo --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index a636a4fe8..e522b65eb 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3879,7 +3879,7 @@ SUBROUTINE mym_condensation (kts,kte, & q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif - !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) + !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) From d4835d1bfe04f1dd3753f08b9d7f1baa37942a1f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 30 Oct 2023 19:31:09 +0000 Subject: [PATCH 067/122] Address reviewers comments. --- CMakeLists.txt | 54 +++++++++---------- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- .../Land/{ => Noah}/namelist_soilveg.f | 0 .../SFC_Models/Land/{ => Noah}/set_soilveg.f | 0 physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 +- 5 files changed, 30 insertions(+), 29 deletions(-) rename physics/SFC_Models/Land/{ => Noah}/namelist_soilveg.f (100%) rename physics/SFC_Models/Land/{ => Noah}/set_soilveg.f (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 97591a2ee..bac0637a4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -79,37 +79,37 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC #------------------------------------------------------------------------------ # List of files that need to be compiled without OpenMP -set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_heating_rates.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_compute_bc.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_config.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_source_functions.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_sw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_fluxes.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_lw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_util_array.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_kind.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_optical_props.F90) +set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_byband.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_compute_bc.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_config.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_source_functions.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_sw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_fluxes.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_lw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_util_array.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_kind.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_optical_props.F90) # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) -if(${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90 IN_LIST SCHEMES) - list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90/fv_sat_adj.F90) endif() # Remove files that need to be compiled with different precision diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 07f4045a2..44cb6aa5b 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -2,7 +2,7 @@ name = lsm_noah type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/namelist_soilveg.f b/physics/SFC_Models/Land/Noah/namelist_soilveg.f similarity index 100% rename from physics/SFC_Models/Land/namelist_soilveg.f rename to physics/SFC_Models/Land/Noah/namelist_soilveg.f diff --git a/physics/SFC_Models/Land/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f similarity index 100% rename from physics/SFC_Models/Land/set_soilveg.f rename to physics/SFC_Models/Land/Noah/set_soilveg.f diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index e7a73ef99..64372bdb8 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -2,7 +2,8 @@ name = noahmpdrv type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 + dependencies = ../Noah/set_soilveg.f ######################################################################## [ccpp-arg-table] From 1d3118299e53cf4a6d25367f27caefbe586d2909 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 31 Oct 2023 02:42:41 +0000 Subject: [PATCH 068/122] More metatdata changes --- .../Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 8a35d469c..f35510ed2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -7,7 +7,7 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = photochem/ozinterp.f90,photochem/ozne_def.f dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 86c052b0e..c885e7c2a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = photochem/ozinterp.f90,photochem/ozne_def.f dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 From e0991a8a2c653ffe989d2e77ea2ecc018512b294 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 2 Nov 2023 19:57:39 +0000 Subject: [PATCH 069/122] Removed requested by the reviewer commented lines. --- physics/module_sf_ruclsm.F90 | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 74d2719d4..47c03c49d 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1521,7 +1521,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ENDIF if(snhei.gt.0.0081_kind_phys*rhowater/rhosn) then -!*** Update snow density for current temperature (Koren et al. 1999) +!*** Update snow density for current temperature (Koren et al 1999,doi:10.1029/1999JD900232.) BSN=delt/3600._kind_phys*c1sn*exp(0.08_kind_phys*min(zero,tsnav)-c2sn*rhosn*1.e-3_kind_phys) if(bsn*snwe*100._kind_phys.lt.1.e-4_kind_phys) goto 777 XSN=rhosn*(exp(bsn*snwe*100._kind_phys)-one)/(bsn*snwe*100._kind_phys) @@ -4079,11 +4079,8 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is tuning parameter added by tgs based on 4 Jan 2017 testing - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys endif if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then @@ -4536,11 +4533,8 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys endif if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then @@ -5213,11 +5207,8 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys if(debug_print) then print *,'SnowTemp xlat,xlon,rhosn,keff', xlat,xlon,rhosn,keff,keff/rhocsn*fact print *,'SNOWTEMP - 0.265/rhocsn',0.265_kind_phys/rhocsn @@ -5789,11 +5780,8 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys if(debug_print) then print *,'End SNOWTEMP - xlat,xlon,rhosn,keff',xlat,xlon,rhosn,keff print *,'End SNOWTEMP - 0.265/rhocsn',0.265/rhocsn From 0dce0a55dbced9c3dcae8da900b836b3128138d5 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 2 Nov 2023 20:03:59 +0000 Subject: [PATCH 070/122] Convective reflectivity added for NSSL,Thompson mp,SAS,GF shal/deep --- physics/GFS_MP_generic_post.F90 | 71 ++++++++++++++++++++++++++++++-- physics/GFS_MP_generic_post.meta | 58 ++++++++++++++++++++++++++ 2 files changed, 125 insertions(+), 4 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 201c0e817..4b4907aea 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -21,7 +21,8 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_q, & + frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice,phil,htop,refl_10cm, & + imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & @@ -40,12 +41,14 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) - +!aligo + integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf + integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour real(kind=kind_phys), intent(in) :: radar_tten_limits(:) integer :: ix_dfi_radar(:) - real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm real(kind=kind_phys), intent(in) :: dtf, frain, con_g, rainmin, rhowater real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc @@ -53,7 +56,7 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, save_t, del - real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii + real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii,phil real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q real(kind=kind_phys), dimension(:,:,:), intent(in) :: dfi_radar_tten @@ -112,6 +115,18 @@ subroutine GFS_MP_generic_post_run( real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice +!aligo + real(kind_phys), parameter :: dbzmin=-20.0 + real(kind_phys) :: cuprate + real(kind_phys) :: ze, ze_conv, dbz_sum + + real(kind_phys), dimension(1:im,1:levs) :: zo + real(kind_phys), dimension(1:im) :: zfrz + real(kind_phys), dimension(1:im) :: factor + real(kind_phys) ze_mp, fctz, delz, xlatd,xlond + logical :: lfrz + + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -121,6 +136,54 @@ subroutine GFS_MP_generic_post_run( do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo +! +! Combine convective reflectivity with MP reflectivity for selected +! parameterizations. + if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl .and. imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf .or. imfshalcnv == imfshalcnv_gf) then + do i=1,im + lfrz = .true. + zfrz(i) = phil(i,1) / con_g + do k = levs, 2, -1 + zo(i,k) = phil(i,k) / con_g + if (gt0(i,k) >= 273.16 .and. lfrz) then + zfrz(i) = zo(i,k) + lfrz = .false. + endif + enddo + enddo + + do i=1,im + factor(i) = 0.0 + enddo + + do i=1,im + if(rainc (i) > 0.0 .or. htop(i) > 0) then + factor(i) = -2./max(1000., zo(i,htop(i)) - zfrz(i)) + endif + enddo + +! combine the reflectivity from both Thompson MP and samfdeep convection + + do k=1,levs + do i=1,im + if(rainc(i) > 0. .and. k <= htop(i)) then + fctz = 0.0 + delz = zo(i,k) - zfrz(i) + if(delz <0.0) then + fctz = 1. ! wrong + else + fctz = 10.**(factor(i)*delz) + endif + cuprate = rainc(i) * 3.6e6 / dtp ! cu precip rate (mm/h) + ze_conv = 300.0 * cuprate**1.4 + ze_conv = fctz * ze_conv + ze_mp = 10._kind_phys ** (0.1 * refl_10cm(i,k)) + dbz_sum = max(DBZmin, 10.*log10(ze_mp + ze_conv)) + refl_10cm(i,k) = dbz_sum + endif + enddo + enddo + endif ! compute surface snowfall, graupel/sleet, freezing rain and precip ice density if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl ) then diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 7cd2ca4b5..9bc7dcffe 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -254,6 +254,64 @@ type = real kind = kind_phys intent = in +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[htop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = out +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[imfshalcnv] + standard_name = control_for_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfshalcnv_gf] + standard_name = identifier_for_grell_freitas_shallow_convection + long_name = flag for Grell-Freitas shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_gf] + standard_name = identifier_for_grell_freitas_deep_convection + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_samf] + standard_name = identifer_for_scale_aware_mass_flux_deep_convection + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature From 6d62ab84c22b60033dec92d7f90ac3643b83da8c Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 3 Nov 2023 16:57:46 +0000 Subject: [PATCH 071/122] Better range checks for output in surface layer, tweaked cloud fractions. last commit before reg tests --- physics/module_bl_mynn.F90 | 21 +++++++++++---------- physics/module_sf_mynn.F90 | 6 +++--- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index e522b65eb..6840f80bf 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3638,7 +3638,8 @@ SUBROUTINE mym_condensation (kts,kte, & real(kind_phys), parameter :: qpct_sfc=0.025 real(kind_phys), parameter :: qpct_pbl=0.030 real(kind_phys), parameter :: qpct_trp=0.040 - real(kind_phys), parameter :: rhcrit =0.83 !for hom pdf min sigma + real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.01 !for cloudpdf = 2 integer :: i,j,k real(kind_phys):: erf @@ -3821,7 +3822,7 @@ SUBROUTINE mym_condensation (kts,kte, & t = th(k)*exner(k) xl = xl_blend(t) ! obtain latent heat qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k) = MAX(MIN(1.0_kind_phys,qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) + rh(k) = MAX(MIN(rhmax, qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) @@ -3863,28 +3864,28 @@ SUBROUTINE mym_condensation (kts,kte, & !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) - !ensure adequate RH & q1 when qi is at least 1e-9 - if (qi(k)>1.e-9) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(9.0 + log10(qi(k)))) + !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) + if (qi(k)>1.e-9 .and. zagl .gt. pblh2) then + rh_hack =min(rhmax, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qc is at least 1e-6 if (qc(k)>1.e-6) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh_hack =min(rhmax, rhcrit + 0.09*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) + rh_hack =min(rhmax, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 048a5c696..3d847348d 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -947,7 +947,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_lnd(I) = TSK_lnd(I)*THCON(I) !(K) THVSK_lnd(I) = THSK_lnd(I)*(1.+EP1*qsfc_lnd(I)) - if(THVSK_lnd(I) < 170. .or. THVSK_lnd(I) > 360.) & + if(THVSK_lnd(I) < 160. .or. THVSK_lnd(I) > 390.) & print *,'THVSK_lnd(I)',itimestep,i,THVSK_lnd(I),THSK_lnd(i),tsurf_lnd(i),tskin_lnd(i),qsfc_lnd(i) endif if(icy(i)) then @@ -956,7 +956,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_ice(I) = TSK_ice(I)*THCON(I) !(K) THVSK_ice(I) = THSK_ice(I)*(1.+EP1*qsfc_ice(I)) !(K) - if(THVSK_ice(I) < 170. .or. THVSK_ice(I) > 360.) & + if(THVSK_ice(I) < 160. .or. THVSK_ice(I) > 390.) & print *,'THVSK_ice(I)',itimestep,i,THVSK_ice(I),THSK_ice(i),tsurf_ice(i),tskin_ice(i),qsfc_ice(i) endif if(wet(i)) then @@ -965,7 +965,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_wat(I) = TSK_wat(I)*THCON(I) !(K) THVSK_wat(I) = THSK_wat(I)*(1.+EP1*QVSH(I)) !(K) - if(THVSK_wat(I) < 170. .or. THVSK_wat(I) > 360.) & + if(THVSK_wat(I) < 160. .or. THVSK_wat(I) > 390.) & print *,'THVSK_wat(I)',i,THVSK_wat(I),THSK_wat(i),tsurf_wat(i),tskin_wat(i),qsfc_wat(i) endif endif ! flag_iter From ce7a3c013f24d0442ced8d9cc6a30250520504c8 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 3 Nov 2023 13:35:30 -0600 Subject: [PATCH 072/122] Updates to Thompson MP after code review --- physics/module_mp_thompson.F90 | 32 +------------------ ...mp_thompson_make_number_concentrations.F90 | 7 ++-- 2 files changed, 4 insertions(+), 35 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b1e5875da..fd5a6e770 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -2469,16 +2469,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -3546,16 +3536,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -6101,16 +6081,6 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -6517,7 +6487,7 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) ygra1 = alog10(max(1.e-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) - N0_exp = max1(dble(gonv_min), min(N0_exp, dble(gonv_max))) + N0_exp = max(dble(gonv_min), min(N0_exp, dble(gonv_max))) lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg ilamg(k) = 1./lamg diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index 496942f21..72a1055dd 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -4,7 +4,6 @@ !>\ingroup aathompson module module_mp_thompson_make_number_concentrations - use machine, only : kind_phys use physcons, only: PI => con_pi implicit none @@ -36,7 +35,7 @@ elemental real function make_IceNumber (Q_ice, temp) !IMPLICIT NONE REAL, PARAMETER:: Ice_density = 890.0 !REAL, PARAMETER:: PI = 3.1415926536 - real(kind_phys), intent(in):: Q_ice, temp + real, intent(in):: Q_ice, temp integer idx_rei real corr, reice, deice double precision lambda @@ -135,7 +134,7 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) !IMPLICIT NONE - real(kind_phys), intent(in):: Q_cloud, qnwfa + real, intent(in):: Q_cloud, qnwfa !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. @@ -174,7 +173,7 @@ elemental real function make_RainNumber (Q_rain, temp) IMPLICIT NONE - real(kind_phys), intent(in):: Q_rain, temp + real, intent(in):: Q_rain, temp double precision:: lambda, N0, qnr !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. From 551e50387c12192ded6965a83818db4bdad41144 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 3 Nov 2023 19:53:45 +0000 Subject: [PATCH 073/122] removing the effective radii limit due to concerns by GFS developers --- physics/module_mp_thompson.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index fd5a6e770..4e0e2b79e 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -5849,7 +5849,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & endif lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) - if (lsml .ne. 1) re_qc1d(k) = max(re_qc1d(k), 7.0E-6) enddo endif From 571cb5941ad1089c207469145c78f57820773dce Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 3 Nov 2023 18:44:48 -0600 Subject: [PATCH 074/122] Bug fix for divide by zero in hail size --- physics/module_mp_thompson.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 4e0e2b79e..44e552160 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -6527,6 +6527,8 @@ function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) resu rho(k) = 0.622*pressure(k)/(R*temperature(k)*(max(1.e-10, qv(k))+0.622)) if (qg(k) .gt. R1) then rg(k) = qg(k)*rho(k) + else + rg(k) = R1 endif enddo From a61a78b08528ea132f9e42a0921f012f2524dc1a Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Sun, 5 Nov 2023 16:34:39 +0000 Subject: [PATCH 075/122] Bug fix: htop set to intent in and modified if condition for convective reflectivity --- physics/GFS_MP_generic_post.F90 | 3 ++- physics/GFS_MP_generic_post.meta | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 4b4907aea..682263fc4 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -139,7 +139,8 @@ subroutine GFS_MP_generic_post_run( ! ! Combine convective reflectivity with MP reflectivity for selected ! parameterizations. - if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl .and. imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf .or. imfshalcnv == imfshalcnv_gf) then + if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & + (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then do i=1,im lfrz = .true. zfrz(i) = phil(i,1) / con_g diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 9bc7dcffe..0660a533a 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -268,7 +268,7 @@ units = index dimensions = (horizontal_loop_extent) type = integer - intent = out + intent = in [refl_10cm] standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm From 9d59ccac9ff77742ae9e417102291b1c08a36fa8 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 6 Nov 2023 10:49:52 -0500 Subject: [PATCH 076/122] add kind_phys where missing --- physics/module_nst_water_prop.f90 | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 6a183da52..7f0f480ae 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -42,7 +42,7 @@ module module_nst_water_prop ! ------------------------------------------------------ !>\ingroup gfs_nst_main_mod !! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). +!! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -124,7 +124,7 @@ end subroutine density !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed +!! This subroutine computes the fraction of the solar radiation absorbed !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! @@ -138,10 +138,11 @@ elemental subroutine sw_ps_9b(z,fxp) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: fxp - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + real(kind=kind_phys), dimension(9), parameter :: & + f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then fxp=1.0-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & @@ -159,7 +160,7 @@ end subroutine sw_ps_9b !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine +!! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -171,10 +172,11 @@ elemental subroutine sw_ps_9b_aw(z,aw) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: aw - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys), dimension(9), parameter :: & + f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & From 793ec64226a3f9bcabe6cf67c937b5b473ac7c24 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 9 Nov 2023 12:54:23 -0500 Subject: [PATCH 077/122] add extra condition in line 2655 of module_sf_noahmp_glacier.F90 to avoid FPE errors in some tests --- physics/module_sf_noahmp_glacier.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_sf_noahmp_glacier.F90 b/physics/module_sf_noahmp_glacier.F90 index 6e34c43af..fcbe40a70 100644 --- a/physics/module_sf_noahmp_glacier.F90 +++ b/physics/module_sf_noahmp_glacier.F90 @@ -2652,7 +2652,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > mwd) then ! 100 mm -> maximum water depth + if(sneqv > mwd .and. isnow /= 0) then ! 100 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) snoflow = (sneqv - mwd) snice(0) = snice(0) - snoflow From d595541a964499d15c9664092dbbe76f21487763 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 9 Nov 2023 23:43:13 +0000 Subject: [PATCH 078/122] Computation of surface fire heat for use in LSM to rrfs_smoke_wrapper. Also, added the fraction of grid cell that is burned out. --- physics/smoke_dust/module_plumerise1.F90 | 4 ---- physics/smoke_dust/module_smoke_plumerise.F90 | 12 ++---------- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 18 +++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 8 ++++++++ 4 files changed, 21 insertions(+), 21 deletions(-) diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 189bf981a..3c23faa6a 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -38,7 +38,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - fire_heat_flux,dxy, & plume_frp, k_min, k_max, & ! RAR: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -67,8 +66,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: fire_heat_flux - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: dxy ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -187,7 +184,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & - fire_heat_flux(i,j),dxy(i,j), & plume_frp(i,j,1), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 9c0dfa49d..61be06181 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -28,7 +28,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & - fire_heat_flux, dxy, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) @@ -44,9 +43,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies - real(kind=kind_phys), intent(in) :: dxy - real(kind=kind_phys), intent(out) :: fire_heat_flux ! JLS - INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -110,7 +106,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & IF (frp_inst Date: Thu, 9 Nov 2023 23:56:17 +0000 Subject: [PATCH 079/122] Small changes to fire feedback to RUC LSM. One more variable is added: fraction of grid cell burned by the fire. This fraction is used to take into account fire's effect on surface albedo. Also, added some debug prints. These changes will change the results only when fire feedback is turned on. The default is .false. --- physics/lsm_ruc.F90 | 24 ++++++++++++++++-------- physics/lsm_ruc.meta | 8 ++++++++ physics/module_sf_ruclsm.F90 | 17 +++++++++++++++-- 3 files changed, 39 insertions(+), 10 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index 79bcbf7b1..ba1b1b4e9 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -360,6 +360,7 @@ subroutine lsm_ruc_run & ! inputs & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & & add_fire_heat_flux, fire_heat_flux_out, & + & frac_grid_burned_out, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -431,7 +432,8 @@ subroutine lsm_ruc_run & ! inputs ! --- in real (kind_phys), dimension(:), intent(in) :: & & rainnc, rainc, ice, snow, graupel, rhonewsn1 - real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out + real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out, & + frac_grid_burned_out logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels @@ -984,13 +986,6 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i) - IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS - ! limit albedo and greenness in the areas affected by the fire - albbck_lnd(i,j) = min(0.1_kind_phys,albbck_lnd(i,j)) - shdfac(i,j) = min(50._kind_phys,shdfac(i,j)) ! % - ENDIF - - !-- spp_lsm if (spp_lsm == 1) then !-- spp for LSM is dimentioned as (1:lsoil_ruc) @@ -1013,6 +1008,19 @@ subroutine lsm_ruc_run & ! inputs alb_lnd(i,j) = albbck_lnd(i,j) * (one-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) solnet_lnd(i,j) = dswsfc(i)*(one-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 + IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS + if (debug_print) then + print *,'alb_lnd before fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + print *,'fire_heat_flux_out, frac_grid_burned_out, xlat/xlon ', & + fire_heat_flux_out(i),frac_grid_burned_out(i),xlat_d(i),xlon_d(i) + endif + ! limit albedo in the areas affected by the fire + alb_lnd(i,j) = alb_lnd(i,j) * (one-frac_grid_burned_out(i)) + 0.08_kind_phys*frac_grid_burned_out(i) + if (debug_print) then + print *,'alb_lnd after fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + endif + ENDIF + cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! sanity check for snow temperature tsnow diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 4cc6a9419..9bc7fa10a 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -1762,6 +1762,14 @@ type = real kind = kind_phys intent = in +[frac_grid_burned_out] + standard_name = fraction_of_grid_cell_burning + long_name = ration of the burnt area to the grid cell area + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 47c03c49d..52fbc8123 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1825,7 +1825,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia UPFLUX = T3 *SOILT XINET = EMISS_snowfree*(GLW-UPFLUX) RNET = GSWnew + XINET - IF ( add_fire_heat_flux ) then ! JLS + IF ( add_fire_heat_flux .and. fire_heat_flux >0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow-free, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF RNET = RNET + fire_heat_flux ENDIF @@ -1949,7 +1952,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if (SEAICE .LT. 0.5_kind_phys) then ! LAND - IF ( add_fire_heat_flux ) then ! JLS + IF ( add_fire_heat_flux .and. fire_heat_flux>0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF RNET = RNET + fire_heat_flux ENDIF if(snow_mosaic==one)then @@ -2242,6 +2248,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(SEAICE .LT. 0.5_kind_phys) then ! LAND + IF ( add_fire_heat_flux .and. fire_heat_flux>0) then ! JLS + IF (debug_print ) THEN + print *,'RNET no snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + endif + RNET = RNET + fire_heat_flux + ENDIF + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & From 6397387e0eb523039806d43e06d7ecf762fc48f5 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 10 Nov 2023 07:14:05 -0700 Subject: [PATCH 080/122] clean up type mix-matches * add one,zero and half * fix instances of reals compared to integer and integers used in real expressions --- physics/module_nst_water_prop.f90 | 119 +++++++++++++++--------------- 1 file changed, 60 insertions(+), 59 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 7f0f480ae..5d71ce82d 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -12,6 +12,8 @@ module module_nst_water_prop public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d + integer, parameter :: kp = kind_phys + real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp, half=0.5_kp ! interface sw_ps_9b module procedure sw_ps_9b @@ -78,7 +80,7 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) + 7.6438e-5 * tc**2 - 8.2467e-7 * tc**3 & + 5.3875e-9 * tc**4 - 1.5 * 5.72466e-3 * s**.5 & + 1.5 * 1.0227e-4 * tc * s**.5 & - - 1.5 * 1.6546e-6 * tc**2 * s**.5 & + - 1.5 * 1.6546e-6 * tc**2 * s**.5 & + 2.0 * 4.8314e-4 * s beta = beta / rhoref @@ -104,7 +106,7 @@ subroutine density(t, s, rho) ! introduction to dynamical oceanography, pp310). ! compression effects are not included - rho = 0.0 + rho = zero tc = t - t0k ! effect of temperature on density (lines 1-3) @@ -144,12 +146,12 @@ elemental subroutine sw_ps_9b(z,fxp) f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! - if(z>0) then - fxp=1.0-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & + if(z>zero) then + fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) else - fxp=0. + fxp=zero endif ! end subroutine sw_ps_9b @@ -178,12 +180,12 @@ elemental subroutine sw_ps_9b_aw(z,aw) f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! - if(z>0) then + if(z>zero) then aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) else - aw=0. + aw=zero endif ! end subroutine sw_ps_9b_aw @@ -212,12 +214,12 @@ elemental subroutine sw_fairall_6exp_v1(z,fxp) real(kind=kind_phys),dimension(9) :: zgamma real(kind=kind_phys),dimension(9) :: f_c ! - if(z>0) then + if(z>zero) then zgamma=z/gamma - f_c=f*(1.-1./zgamma*(1-exp(-zgamma))) + f_c=f*(one-one/zgamma*(one-exp(-zgamma))) fxp=sum(f_c) else - fxp=0. + fxp=zero endif ! end subroutine sw_fairall_6exp_v1 @@ -251,15 +253,15 @@ elemental subroutine sw_fairall_6exp_v1_aw(z,aw) real(kind=kind_phys),dimension(9) :: zgamma real(kind=kind_phys),dimension(9) :: f_aw ! - if(z>0) then + if(z>zero) then zgamma=z/gamma - f_aw=(f/z)*((gamma/z)*(1-exp(-zgamma))-exp(-zgamma)) + f_aw=(f/z)*((gamma/z)*(one-exp(-zgamma))-exp(-zgamma)) aw=sum(f_aw) ! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw else - aw=0. + aw=zero endif ! end subroutine sw_fairall_6exp_v1_aw @@ -293,9 +295,9 @@ elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! f_sum=(zgamma/z)*exp(-zgamma) ! sum=sum(f_sum) - sum=(1.0/gamma(1))*exp(-z/gamma(1))+(1.0/gamma(2))*exp(-z/gamma(2))+(1.0/gamma(3))*exp(-z/gamma(3))+ & - (1.0/gamma(4))*exp(-z/gamma(4))+(1.0/gamma(5))*exp(-z/gamma(5))+(1.0/gamma(6))*exp(-z/gamma(6))+ & - (1.0/gamma(7))*exp(-z/gamma(7))+(1.0/gamma(8))*exp(-z/gamma(8))+(1.0/gamma(9))*exp(-z/gamma(9)) + sum=(one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & + (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & + (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) ! end subroutine sw_fairall_6exp_v1_sum ! @@ -321,10 +323,10 @@ elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(1.-exp(-z/8.e-4))) + if(z>zero) then + df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(one-exp(-z/8.e-4))) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_fairall_simple_v1 @@ -352,10 +354,10 @@ elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(1.-exp(-z/8.e-4))) + if(z>zero) then + df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(one-exp(-z/8.e-4))) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_wick_v1 @@ -388,11 +390,11 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) & ,gamma=(/12.8,0.357,0.014/) ! - if(z>0) then - f_c = f*gamma(int(1-exp(-z/gamma))) - df_sol_z = f_sol_0*(1.0-sum(f_c)/z) + if(z>zero) then + f_c = f*gamma(int(one-exp(-z/gamma))) + df_sol_z = f_sol_0*(one-sum(f_c)/z) else - df_sol_z = 0. + df_sol_z = zero endif ! end subroutine sw_soloviev_3exp_v1 @@ -416,14 +418,14 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - +0.27*0.357*(1.-exp(-z/0.357)) & - +.45*12.82*(1.-exp(-z/12.82)))/z & + if(z>zero) then + df_sol_z=f_sol_0*(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & ) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_soloviev_3exp_v2 @@ -445,15 +447,15 @@ elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) real(kind=kind_phys),intent(out):: aw real(kind=kind_phys):: fxp ! - if(z>0) then - fxp=(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - + 0.27*0.357*(1.-exp(-z/0.357)) & - + 0.45*12.82*(1.-exp(-z/12.82)))/z & + if(z>zero) then + fxp=(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & ) - aw=1.0-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) + aw=one-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) else - aw=0. + aw=zero endif end subroutine sw_soloviev_3exp_v2_aw ! @@ -475,10 +477,10 @@ elemental subroutine sw_ohlmann_v1(z,fxp) real(kind=kind_phys),intent(in):: z real(kind=kind_phys),intent(out):: fxp ! - if(z>0) then - fxp=.065+11.*z-6.6e-5/z*(1.-exp(-z/8.0e-4)) + if(z>zero) then + fxp=.065+11.*z-6.6e-5/z*(one-exp(-z/8.0e-4)) else - fxp=0. + fxp=zero endif ! end subroutine sw_ohlmann_v1 @@ -497,7 +499,7 @@ function grv(lat) phi=lat*pi/180 x=sin(phi) - grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) + grv=gamma*(one+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) !print *,'grav=',grv,lat end function grv @@ -511,14 +513,14 @@ subroutine solar_time_from_julian(jday,xlon,soltim) real(kind=kind_phys), intent(in) :: jday real(kind=kind_phys), intent(in) :: xlon real(kind=kind_phys), intent(out) :: soltim - real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime + real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime integer :: nn ! fjd=jday-floor(jday) fjd=jday - xhr=floor(fjd*24.0)-sign(12.0,fjd-0.5) - xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-0.5))*60 - xsec=0 + xhr=floor(fjd*24.0)-sign(12.0,fjd-half) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 + xsec=zero intime=xhr+xmin/60.0+xsec/3600.0+24.0 soltim=mod(xlon/15.0+intime,24.0)*3600.0 end subroutine solar_time_from_julian @@ -570,7 +572,7 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) jd=iw3jdn(jyr,jmnth,jday) if(jhr.lt.12) then jd=jd-1 - fjd=0.5+jhr/24.+jmn/1440. + fjd=half+jhr/24.+jmn/1440. else fjd=(jhr-12)/24.+jmn/1440. endif @@ -618,35 +620,35 @@ subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) ! ! get the mean warming in the range of z=z1 to z=z2 ! - dtw = 0.0 - if ( xt > 0.0 ) then + dtw = zero + if ( xt > zero ) then dt_warm = (xt+xt)/xz ! Tw(0) if ( z1 < z2) then if ( z2 < xz ) then - dtw = dt_warm*(1.0-(z1+z2)/(xz+xz)) + dtw = dt_warm*(one-(z1+z2)/(xz+xz)) elseif ( z1 < xz .and. z2 >= xz ) then - dtw = 0.5*(1.0-z1/xz)*dt_warm*(xz-z1)/(z2-z1) + dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < xz ) then - dtw = dt_warm*(1.0-z1/xz) + dtw = dt_warm*(one-z1/xz) endif endif endif ! ! get the mean cooling in the range of z=z1 to z=z2 ! - dtc = 0.0 - if ( zc > 0.0 ) then + dtc = zero + if ( zc > zero ) then if ( z1 < z2) then if ( z2 < zc ) then - dtc = dt_cool*(1.0-(z1+z2)/(zc+zc)) + dtc = dt_cool*(one-(z1+z2)/(zc+zc)) elseif ( z1 < zc .and. z2 >= zc ) then - dtc = 0.5*(1.0-z1/zc)*dt_cool*(zc-z1)/(z2-z1) + dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < zc ) then - dtc = dt_cool*(1.0-z1/zc) + dtc = dt_cool*(one-z1/zc) endif endif endif @@ -706,7 +708,6 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) ! Local variables integer :: i,j real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi - real (kind=kind_phys), parameter :: zero=0.0, half=0.5, one=1.0 !$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) From 3714e76763a91841712bc38f1f7ef4cc2fe01730 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 13 Nov 2023 10:19:49 -0500 Subject: [PATCH 081/122] add parameter zero and clean up nst_parameters * fix type mis-match in call to int_epn using parameter zero in module_nst_model --- physics/module_nst_model.f90 | 196 ++++++++++++++++-------------- physics/module_nst_parameters.f90 | 50 ++++---- physics/physcons.F90 | 4 +- 3 files changed, 129 insertions(+), 121 deletions(-) diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index 980035fe6..d47ab838b 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -1,5 +1,5 @@ !>\file module_nst_model.f90 -!! This file contains the diurnal thermocline layer model (DTM) of +!! This file contains the diurnal thermocline layer model (DTM) of !! the GFS NSST scheme. !>\defgroup dtm_module GFS NSST Diurnal Thermocline Model @@ -12,7 +12,7 @@ module nst_module ! -! the module of diurnal thermocline layer model +! the module of diurnal thermocline layer model ! use machine , only : kind_phys use module_nst_parameters, only: z_w_max,z_w_min,z_w_ini,eps_z_w,eps_conv, & @@ -23,6 +23,14 @@ module nst_module use module_nst_water_prop, only: sw_rad_skin,sw_ps_9b,sw_ps_9b_aw implicit none + private + + integer, parameter :: kp = kind_phys + real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp + + public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth + public :: cal_w, cal_ttop, cool_skin, dtl_reset + contains !>\ingroup gfs_nst_main_mod @@ -72,12 +80,12 @@ subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! logical lprnt ! if (lprnt) print *,' first xt=',xt - if ( xt <= 0.0 ) then ! dtl doesn't exist yet + if ( xt <= zero ) then ! dtl doesn't exist yet call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) - elseif ( xt > 0.0 ) then ! dtl already exists + elseif ( xt > zero ) then ! dtl already exists ! -! forward the system one time step +! forward the system one time step ! call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & beta,alon,sinlat,soltim,grav,le,d_conv, & @@ -150,7 +158,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& xtts0 = xtts xzts0 = xzts speed = max(1.0e-8, xu0*xu0+xv0*xv0) - + alat = asin(sinlat)*rad2deg fc = const_rot*sinlat @@ -177,7 +185,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& ! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & ! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich - if ( xt1 <= 0.0 .or. xz1 <= 0.0 .or. xz1 > z_w_max ) then + if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) return endif @@ -189,7 +197,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & *grav*xz0*xz0/(4.0*rich) )*xzts0 )) xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) - + ! if ( 2.0*xt1/xz1 > 0.001 ) then ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& ! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te @@ -210,7 +218,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& ! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 - if ( xt2 <= 0.0 .or. xz2 <= 0.0 .or. xz2 > z_w_max ) then + if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) return endif @@ -229,7 +237,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& xzts = 0.5*(xzts1 + xzts2) xtts = 0.5*(xtts1 + xtts2) - if ( xt <= 0.0 .or. xz < 0.0 .or. xz > z_w_max ) then + if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) endif @@ -249,7 +257,7 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, ! free convection adjustment (fca); ! top layer adjustment (tla); ! maximum warming adjustment (mwa) -! +! integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz @@ -260,16 +268,16 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, ! real(kind=kind_phys) xz_mda - tr_mda = 0.0; tr_fca = 0.0; tr_tla = 0.0; tr_mwa = 0.0 + tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero ! apply mda if ( z_w_min > xz ) then xz_mda = z_w_min endif ! apply fca - if ( d_conv > 0.0 ) then + if ( d_conv > zero ) then xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) - tr_fca = 1.0 + tr_fca = 1.0 if ( xz_fca >= z_w_max ) then call dtl_reset_cv(xt,xs,xu,xv,xz) go to 10 @@ -280,13 +288,13 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, call sw_ps_9b(dz,fw) q_warm=fw*i0-q !total heat abs in warm layer - if ( q_warm > 0.0 ) then + if ( q_warm > zero ) then call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) ! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) if ( ttop > ttop0 ) then xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 - tr_tla = 1.0 + tr_tla = 1.0 if ( xz_tla >= z_w_max ) then call dtl_reset_cv(xt,xs,xu,xv,xz) go to 10 @@ -306,7 +314,7 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) 10 continue - + end subroutine dtm_1p_zwa !>\ingroup gfs_nst_main_mod @@ -314,7 +322,7 @@ end subroutine dtm_1p_zwa subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) ! apply xz adjustment: free convection adjustment (fca); -! +! real(kind=kind_phys), intent(in) :: d_conv,xt,xtts real(kind=kind_phys), intent(inout) :: xz,xzts ! local variables @@ -332,14 +340,14 @@ end subroutine dtm_1p_fca subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) ! apply xz adjustment: top layer adjustment (tla); -! +! real(kind=kind_phys), intent(in) :: dz,te,xt,xtts real(kind=kind_phys), intent(inout) :: xz,xzts ! local variables real(kind=kind_phys) tem ! tem = xt*(xt-dz*te) - if (tem > 0.0) then + if (tem > zero) then xz = (xt+sqrt(xt*(xt-dz*te)))/te else xz = z_w_max @@ -389,8 +397,8 @@ subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) ! local variables real(kind=kind_phys) :: ta ! - ta = max(0.0,2.0*xt/xz-dta) - if ( ta > 0.0 ) then + ta = max(zero,2.0*xt/xz-dta) + if ( ta > zero ) then xz = 2.0*xt/ta else xz = z_w_max @@ -441,39 +449,39 @@ subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) s1 = alpha*rho*t-omg_m*beta*rho*s - if ( s1 == 0.0 ) then - d_conv = 0.0 + if ( s1 == zero ) then + d_conv = zero else fac1 = alpha*q/cp_w+omg_m*beta*rho*sep - if ( i0 <= 0.0 ) then + if ( i0 <= zero ) then d_conv2=(2.0*xz*timestep/s1)*fac1 - if ( d_conv2 > 0.0 ) then + if ( d_conv2 > zero ) then d_conv = sqrt(d_conv2) else - d_conv = 0.0 + d_conv = zero endif - elseif ( i0 > 0.0 ) then + elseif ( i0 > zero ) then - d_conv_ini = 0.0 + d_conv_ini = zero iter_conv: do n = 1, niter_conv call sw_ps_9b(d_conv_ini,fxp) call sw_ps_9b_aw(d_conv_ini,aw) s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep d_conv2=(2.0*xz*timestep/s1)*s2 - if ( d_conv2 < 0.0 ) then - d_conv = 0.0 + if ( d_conv2 < zero ) then + d_conv = zero exit iter_conv endif d_conv = sqrt(d_conv2) if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv d_conv_ini = d_conv enddo iter_conv - d_conv = max(0.0,min(d_conv,z_w_max)) - endif ! if ( i0 <= 0.0 ) then + d_conv = max(zero,min(d_conv,z_w_max)) + endif ! if ( i0 <= zero ) then - endif ! if ( s1 == 0.0 ) then + endif ! if ( s1 == zero ) then ! if ( d_conv > 0.01 ) then ! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & @@ -488,7 +496,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables ! - + integer,intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le @@ -519,9 +527,9 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! output variables ! ! xt : onset t content in dtl -! xs : onset s content in dtl -! xu : onset u content in dtl -! xv : onset v content in dtl +! xs : onset s content in dtl +! xu : onset u content in dtl +! xv : onset v content in dtl ! xz : onset dtl thickness (m) ! xzts : onset d(xz)/d(ts) (m/k ) ! xtts : onset d(xt)/d(ts) (m) @@ -531,15 +539,15 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! initializing dtl (just before the onset) ! - xt0 = 0.0 - xs0 = 0.0 - xu0 = 0.0 - xv0 = 0.0 + xt0 = zero + xs0 = zero + xu0 = zero + xv0 = zero z_w_tmp=z_w_ini call sw_ps_9b(z_w_tmp,fw) -! fw=0.5 ! +! fw=0.5 ! q_warm=fw*i0-q !total heat abs in warm layer if ( abs(alat) > 1.0 ) then @@ -552,9 +560,9 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & coeff2=omg_m*beta*grav*rho warml = coeff1*q_warm-coeff2*sep - if ( warml > 0.0 .and. q_warm > 0.0) then + if ( warml > zero .and. q_warm > zero) then iters_z_w: do n = 1,niter_z_w - if ( warml > 0.0 .and. q_warm > 0.0 ) then + if ( warml > zero .and. q_warm > zero ) then z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) else z_w = z_w_max @@ -578,7 +586,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! update xt, xs, xu, xv ! - if ( z_w < z_w_max .and. q_warm > 0.0) then + if ( z_w < z_w_max .and. q_warm > zero) then call sw_ps_9b(z_w,fw) q_warm=fw*i0-q !total heat abs in warm layer @@ -599,7 +607,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & xz1 = max(xz1,z_w_min) - if ( xt1 < 0.0 .or. xz1 > z_w_max ) then + if ( xt1 < zero .or. xz1 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) return endif @@ -630,16 +638,16 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) endif - if ( xt < 0.0 .or. xz > z_w_max ) then + if ( xt < zero .or. xz > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) endif - + return end subroutine dtm_onset !>\ingroup gfs_nst_main_mod -!! This subroutine computes coefficients (\a w_0 and \a w_d) to +!! This subroutine computes coefficients (\a w_0 and \a w_d) to !! calculate d(tw)/d(ts). subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) ! @@ -648,15 +656,15 @@ subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) ! input variables ! ! kdt : the number of time step -! xt : dtl heat content -! xz : dtl depth +! xt : dtl heat content +! xz : dtl depth ! xzts : d(zw)/d(ts) ! xtts : d(xt)/d(ts) ! ! output variables ! -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) +! w_0 : coefficint 1 to calculate d(tw)/d(ts) +! w_d : coefficint 2 to calculate d(tw)/d(ts) integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts @@ -719,11 +727,11 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) ! alpha ! beta ! grav -! d_1p : dtl depth before sfs applied +! d_1p : dtl depth before sfs applied ! ! output variables ! -! xz : dtl depth +! xz : dtl depth integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p @@ -736,10 +744,10 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) cc = ri_g/(grav*c2) tem = alpha*xt - beta*xs - if (tem > 0.0) then + if (tem > zero) then d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) else - d_sfs = 0.0 + d_sfs = zero endif ! xz0 = d_1p @@ -750,10 +758,10 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) ! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs ! xz0 = d_sfs ! enddo iter_sfs - + ! ze = a2*d_sfs ! not used! - l = int_epn(0.0,d_sfs,0.0,d_sfs,2) + l = int_epn(zero,d_sfs,zero,d_sfs,2) ! t_sfs = xt/l ! xz = (xt+xt) / t_sfs @@ -774,20 +782,20 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) ! kdt : the number of record ! xt : heat content in dtl ! xz : dtl depth (m) -! c_0 : coefficint 1 to calculate d(tc)/d(ts) -! c_d : coefficint 2 to calculate d(tc)/d(ts) -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) +! c_0 : coefficint 1 to calculate d(tc)/d(ts) +! c_d : coefficint 2 to calculate d(tc)/d(ts) +! w_0 : coefficint 1 to calculate d(tw)/d(ts) +! w_d : coefficint 2 to calculate d(tw)/d(ts) ! ! output variables ! -! tztr : d(tz)/d(tr) +! tztr : d(tz)/d(tr) integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z real(kind=kind_phys), intent(out) :: tztr - if ( xt > 0.0 ) then + if ( xt > zero ) then if ( z <= zc ) then ! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) @@ -797,7 +805,7 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) elseif ( z >= zw ) then tztr = 1.0 endif - elseif ( xt == 0.0 ) then + elseif ( xt == zero ) then if ( z <= zc ) then ! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) tztr = (1.0-z*c_d)/(1.0+c_0) @@ -812,7 +820,7 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) end subroutine cal_tztr !>\ingroup gfs_nst_main_mod -!> This subroutine contains the upper ocean cool-skin parameterization +!> This subroutine contains the upper ocean cool-skin parameterization !! (Fairall et al, 1996 \cite fairall_et_al_1996). subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) ! @@ -831,8 +839,8 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q ! ts : oceanic surface temperature ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes ! hl_ts : d(hl)/d(ts) -! grav : gravity -! le : +! grav : gravity +! le : ! ! output: ! deltat_c: cool-skin temperature correction (degrees k) @@ -876,33 +884,33 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q if ( deltaf > 0 ) then deltat_c = deltaf * z_c / kw else - deltat_c = 0. - z_c = 0. + deltat_c = zero + z_c = zero endif ! ! calculate c_0 & c_d ! - if ( z_c > 0.0 ) then + if ( z_c > zero ) then cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 cc3 = beta*sss*cp_w/(alpha*le) zcsq = z_c * z_c a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - if ( hb > 0.0 .and. zcsq > 0.0 .and. alpha > 0.0) then + if ( hb > zero .and. zcsq > zero .and. alpha > zero) then bc1 = zcsq * (q_ts+cc3*hl_ts) bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) zc_ts = bc1/bc2 ! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) - c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi - c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi + c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi else - b_c = 0.0 - zc_ts = 0.0 - c_0 = z_c*q_ts*tcwi + b_c = zero + zc_ts = zero + c_0 = z_c*q_ts*tcwi c_d = -q_ts*tcwi endif @@ -910,12 +918,12 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q ! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 ! endif -! c_0 = z_c*q_ts/tcw -! c_d = -q_ts/tcw +! c_0 = z_c*q_ts/tcw +! c_d = -q_ts/tcw else - c_0 = 0.0 - c_d = 0.0 + c_0 = zero + c_d = zero endif ! if ( z_c > 0.0 ) then end subroutine cool_skin @@ -935,7 +943,7 @@ real function int_epn(z1,z2,zmx,ztr,n) m = nint((z2-z1)/delz) fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) - int = 0.0 + int = zero do i = 1, m-1 zi = z1 + delz*float(i) fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) @@ -948,10 +956,10 @@ end function int_epn !! This subroutine resets the value of xt,xs,xu,xv,xz. subroutine dtl_reset_cv(xt,xs,xu,xv,xz) real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz - xt = 0.0 - xs = 0.0 - xu = 0.0 - xv = 0.0 + xt = zero + xs = zero + xu = zero + xv = zero xz = z_w_max end subroutine dtl_reset_cv @@ -959,13 +967,13 @@ end subroutine dtl_reset_cv !! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts - xt = 0.0 - xs = 0.0 - xu = 0.0 - xv = 0.0 + xt = zero + xs = zero + xu = zero + xv = zero xz = z_w_max - xtts = 0.0 - xzts = 0.0 + xtts = zero + xzts = zero end subroutine dtl_reset end module nst_module diff --git a/physics/module_nst_parameters.f90 b/physics/module_nst_parameters.f90 index ee0a34914..1e1a39ca1 100644 --- a/physics/module_nst_parameters.f90 +++ b/physics/module_nst_parameters.f90 @@ -12,34 +12,34 @@ module module_nst_parameters use machine, only : kind_phys ! ! air constants and coefficients from the atmospehric model - use physcons, only: & - eps => con_eps & - ,cp_a => con_cp & !< spec heat air @p (j/kg/k) - , epsm1 => con_epsm1 & - , hvap => con_hvap & !< lat heat h2o cond (j/kg) - ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) - ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) - ,omega => con_omega & !< ang vel of earth (1/s) - ,rvrdm1 => con_fvirt & - ,rd => con_rd & - ,rocp => con_rocp & !< r/cp + use physcons, only: & + eps => con_eps & !< con_rd/con_rv (nd) + ,cp_a => con_cp & !< spec heat air @p (j/kg/k) + ,epsm1 => con_epsm1 & !< eps - 1 (nd) + ,hvap => con_hvap & !< lat heat h2o cond (j/kg) + ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) + ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) + ,omega => con_omega & !< ang vel of earth (1/s) + ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) + ,rd => con_rd & !< gas constant air (j/kg/k) + ,rocp => con_rocp & !< r/cp ,pi => con_pi ! ! note: take timestep from here later - public + public integer :: & niter_conv = 5, & niter_z_w = 5, & niter_sfs = 5 - real (kind=kind_phys), parameter :: & + real (kind=kind_phys), parameter :: & ! ! general constants sec_in_day=86400. & ,sec_in_hour=3600. & ,solar_time_6am=21600.0 & ,const_rot=0.000073 & !< constant to calculate corioli force - ,ri_c=0.65 & - ,ri_g=0.25 & + ,ri_c=0.65 & + ,ri_g=0.25 & ,eps_z_w=0.01 & !< criteria to finish iterations for z_w ,eps_conv=0.01 & !< criteria to finish iterations for d_conv ,eps_sfs=0.01 & !< criteria to finish iterations for d_sfs @@ -52,7 +52,7 @@ module module_nst_parameters ,tau_min=0.005 & !< minimum of wind stress for dtm ,exp_const=9.5 & !< coefficient in exponet profile ,delz=0.1 & !< vertical increment for integral calculation (m) - ,von=0.4 & !< von karman's "constant" + ,von=0.4 & !< von karman's "constant" ,t0k=273.16 & !< celsius to kelvin ,gray=0.97 & ,sst_max=308.16 & @@ -63,20 +63,20 @@ module module_nst_parameters ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect ,visw=1.e-6 & !< m2/s kinematic viscosity water ,novalue=0 & - ,smallnumber=1.e-6 & + ,smallnumber=1.e-6 & ,timestep_oc=sec_in_day/8. & !< time step in the ocean model (3 hours) - ,radian=2.*pi/180. & - ,rad2deg=180./pi & + ,radian=2.*pi/180. & + ,rad2deg=180./pi & ,cp_w=4000. & !< specific heat water (j/kg/k ) ,rho0_w=1022.0 & !< density water (kg/m3 ) (or 1024.438) ,vis_w=1.e-6 & !< kinematic viscosity water (m2/s ) ,tc_w=0.6 & !< thermal conductivity water (w/m/k ) ,capa_w =3950.0 & !< heat capacity of sea water ! - ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) + ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) !!$!============================================ !!$ -!!$ ,lvapor=2.453e6 & ! latent heat of vaporization note: make it function of t ????? note the same as hvap +!!$ ,lvapor=2.453e6 & ! latent heat of vaporization note: make it function of t ????? note the same as hvap !!$ ,alpha=1 ! thermal expansion coefficient !!$ ,beta ! saline contraction coefficient !!$ ,cp=1 !=1 specific heat of sea water @@ -95,7 +95,7 @@ module module_nst_parameters !!$ fdg=1.00 !based on results from flux workshop august 1995 !!$ tok=273.16 ! celsius to kelvin !!$ twopi=3.14159*2. -!!$ +!!$ !!$c air constants and coefficients !!$ rgas=287.1 !j/kg/k gas const. dry air !!$ xlv=(2.501-0.00237*ts)*1e+6 !j/kg latent heat of vaporization at ts @@ -104,7 +104,7 @@ module module_nst_parameters !!$ rhoa=p*100./(rgas*(t+tok)*(1.+.61*q)) !kg/m3 moist air density ( " ) !!$ visa=1.326e-5*(1+6.542e-3*t+8.301e-6*t*t-4.84e-9*t*t*t) !m2/s !!$ !kinematic viscosity of dry air - andreas (1989) crrel rep. 89-11 -!!$c +!!$c !!$c cool skin constants !!$ al=2.1e-5*(ts+3.2)**0.79 !water thermal expansion coefft. !!$ be=0.026 !salinity expansion coefft. @@ -126,11 +126,11 @@ module module_nst_parameters !!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 !!$ real , parameter :: hslab=50.0 !slab ocean depth !!$ real , parameter :: bad=-1.0e+10 -!!$ real , parameter :: tmin=2.68e+02 +!!$ real , parameter :: tmin=2.68e+02 !!$ real , parameter :: tmax=3.11e+02 !!$ !!$ real, parameter :: grav =9.81 !gravity, kg/m/s^2 -!!$ real, parameter :: capa =3950.0 !heat capacity of sea water +!!$ real, parameter :: capa =3950.0 !heat capacity of sea water !!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 !!$ real, parameter :: tmin=2.68e+02 !normal minimal temp !!$ real, parameter :: tmax=3.11e+02 !normal max temp diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 19a03ef20..4d86301e2 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -33,7 +33,7 @@ !> This module contains some of the most frequently used math and physics !! constants for GCM models. - module physcons + module physcons ! use machine, only: kind_phys, kind_dyn ! @@ -44,7 +44,7 @@ module physcons !> \name Math constants ! real(kind=kind_phys),parameter:: con_pi =3.1415926535897931 !< pi real(kind=kind_phys),parameter:: con_pi =4.0d0*atan(1.0d0) !< pi - real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 + real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 real(kind=kind_phys),parameter:: con_sqrt3 =1.732051e+0_kind_phys !< quare root of 3 !> \name Geophysics/Astronomy constants From 86eb1bdc2ccd250575066a5a736201fd8e17e65b Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Tue, 14 Nov 2023 14:10:02 +0000 Subject: [PATCH 082/122] Bug fix for conv refl,remove conv refl computation from the cu_gf driver --- physics/GFS_MP_generic_post.F90 | 11 ++++----- physics/cu_gf_driver_post.F90 | 24 +------------------- physics/cu_gf_driver_post.meta | 40 --------------------------------- 3 files changed, 5 insertions(+), 70 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 682263fc4..f1b15e01d 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -142,9 +142,10 @@ subroutine GFS_MP_generic_post_run( if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then do i=1,im + factor(i) = 0.0 lfrz = .true. zfrz(i) = phil(i,1) / con_g - do k = levs, 2, -1 + do k = levs, 1, -1 zo(i,k) = phil(i,k) / con_g if (gt0(i,k) >= 273.16 .and. lfrz) then zfrz(i) = zo(i,k) @@ -152,13 +153,9 @@ subroutine GFS_MP_generic_post_run( endif enddo enddo - - do i=1,im - factor(i) = 0.0 - enddo - +! do i=1,im - if(rainc (i) > 0.0 .or. htop(i) > 0) then + if(rainc (i) > 0.0 .and. htop(i) > 0) then factor(i) = -2./max(1000., zo(i,htop(i)) - zfrz(i)) endif enddo diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 5adf3ac42..111bf0863 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -15,7 +15,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m,dt, garea, raincv, maxupmf, refl_10cm, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg) use machine, only: kind_phys @@ -25,25 +25,17 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: im, km real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), dimension(:),intent(in) :: garea real(kind_phys), intent(out) :: prevst(:,:) real(kind_phys), intent(out) :: prevsq(:,:) integer, intent(in) :: cactiv(:) integer, intent(in) :: cactiv_m(:) real(kind_phys), intent(out) :: conv_act(:) real(kind_phys), intent(out) :: conv_act_m(:) - ! for Radar reflectivity - real(kind_phys), intent(in) :: dt - real(kind_phys), intent(in) :: raincv(:), maxupmf(:) - real(kind_phys), intent(inout) :: refl_10cm(:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) integer, intent(out) :: errflg ! Local variables - real(kind_phys), parameter :: dbzmin=-10.0 - real(kind_phys) :: cuprate - real(kind_phys) :: ze, ze_conv, dbz_sum integer :: i, k ! Initialize CCPP error handling variables @@ -65,20 +57,6 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m else conv_act_m(i)=0.0 endif - ! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f) - ze = 0.0 - ze_conv = 0.0 - dbz_sum = 0.0 - cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h) - if(cuprate .lt. 0.05) cuprate=0. - ze_conv = 300.0 * cuprate**1.5 - if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then - do k = 1, km - ze = 10._kind_phys ** (0.1 * refl_10cm(i,k)) - dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv)) - refl_10cm(i,k) = dbz_sum - enddo - endif enddo !$acc end kernels diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 48e762cb4..6c6ceeb66 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -83,46 +83,6 @@ type = real kind = kind_phys intent = out -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[garea] - standard_name = cell_area - long_name = grid cell area - units = m2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[raincv] - standard_name = lwe_thickness_of_deep_convective_precipitation_amount - long_name = deep convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[maxupmf] - standard_name = maximum_convective_updraft_mass_flux - long_name = maximum convective updraft mass flux within a column - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[refl_10cm] - standard_name = radar_reflectivity_10cm - long_name = instantaneous refl_10cm - units = dBZ - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8759f1c3897f49aaa05c04e0ffd5029683884761 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 15 Nov 2023 07:34:27 -0500 Subject: [PATCH 083/122] fix grv function for argument value --- physics/module_nst_water_prop.f90 | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 6a183da52..57f27f329 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -42,7 +42,7 @@ module module_nst_water_prop ! ------------------------------------------------------ !>\ingroup gfs_nst_main_mod !! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). +!! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -124,7 +124,7 @@ end subroutine density !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed +!! This subroutine computes the fraction of the solar radiation absorbed !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! @@ -159,7 +159,7 @@ end subroutine sw_ps_9b !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine +!! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -483,20 +483,16 @@ end subroutine sw_ohlmann_v1 ! !>\ingroup gfs_nst_main_mod -function grv(lat) - real(kind=kind_phys) :: lat - real(kind=kind_phys) :: gamma,c1,c2,c3,c4,pi,phi,x +function grv(x) + real(kind=kind_phys) :: x !< sin(lat) + real(kind=kind_phys) :: gamma,c1,c2,c3,c4 gamma=9.7803267715 c1=0.0052790414 c2=0.0000232718 c3=0.0000001262 c4=0.0000000007 - pi=3.141593 - phi=lat*pi/180 - x=sin(phi) - grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) - !print *,'grav=',grv,lat + grv=gamma*(1.0+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) end function grv !>\ingroup gfs_nst_main_mod From 967740ffd92709ebb162921d5cad3c8428ba740e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 15 Nov 2023 12:15:55 -0500 Subject: [PATCH 084/122] fix intent in mp_thompson.meta --- physics/mp_thompson.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 293dd7625..ae1072d39 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -617,7 +617,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [fullradar_diag] standard_name = do_full_radar_reflectivity long_name = flag for computing full radar reflectivity From a85b2c8d817d23c6dc7f196f9b07afd661d10532 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 16 Nov 2023 13:46:41 +0000 Subject: [PATCH 085/122] clean up a bit, remove comments and temporary parameters --- physics/GFS_MP_generic_post.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index f1b15e01d..803f0334a 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -21,7 +21,7 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice,phil,htop,refl_10cm, & + frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & @@ -41,7 +41,6 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) -!aligo integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals @@ -115,7 +114,6 @@ subroutine GFS_MP_generic_post_run( real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice -!aligo real(kind_phys), parameter :: dbzmin=-20.0 real(kind_phys) :: cuprate real(kind_phys) :: ze, ze_conv, dbz_sum @@ -123,7 +121,7 @@ subroutine GFS_MP_generic_post_run( real(kind_phys), dimension(1:im,1:levs) :: zo real(kind_phys), dimension(1:im) :: zfrz real(kind_phys), dimension(1:im) :: factor - real(kind_phys) ze_mp, fctz, delz, xlatd,xlond + real(kind_phys) ze_mp, fctz, delz logical :: lfrz From 152132604f4fc80ce7508a9b39ca5684a8ec18f5 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 16 Nov 2023 16:51:51 +0000 Subject: [PATCH 086/122] Take advantage of onebg to avoid division --- physics/GFS_MP_generic_post.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 803f0334a..3527c0613 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -142,9 +142,9 @@ subroutine GFS_MP_generic_post_run( do i=1,im factor(i) = 0.0 lfrz = .true. - zfrz(i) = phil(i,1) / con_g + zfrz(i) = phil(i,1)*onebg do k = levs, 1, -1 - zo(i,k) = phil(i,k) / con_g + zo(i,k) = phil(i,k)*onebg if (gt0(i,k) >= 273.16 .and. lfrz) then zfrz(i) = zo(i,k) lfrz = .false. From 78cab8732919882fe5b7d3bded1fe176d300ea88 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Fri, 17 Nov 2023 16:49:51 +0000 Subject: [PATCH 087/122] Replace constant 273.16 with con_t0c, a physical constant already defined. --- physics/GFS_MP_generic_post.F90 | 6 +++--- physics/GFS_MP_generic_post.meta | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 3527c0613..d9d30fb90 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -22,7 +22,7 @@ subroutine GFS_MP_generic_post_run( im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & - imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & + imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & @@ -44,7 +44,7 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals - real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour + real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) integer :: ix_dfi_radar(:) real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm @@ -145,7 +145,7 @@ subroutine GFS_MP_generic_post_run( zfrz(i) = phil(i,1)*onebg do k = levs, 1, -1 zo(i,k) = phil(i,k)*onebg - if (gt0(i,k) >= 273.16 .and. lfrz) then + if (gt0(i,k) >= con_t0c .and. lfrz) then zfrz(i) = zo(i,k) lfrz = .false. endif diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 0660a533a..a6137643d 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -312,6 +312,14 @@ dimensions = () type = integer intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature From f8e160157ff4466e606ba1b1b55156ed0c7af546 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 26 Nov 2023 13:09:56 -0500 Subject: [PATCH 088/122] rename and update files * remove continuation lines in column 6 and rename files as f90 * remove unused variables and make only needed variables, routines or procedures public * move use statements to module level, remove implicit none and use statements in SRs --- physics/module_nst_model.f90 | 1803 ++++++++++++++--------------- physics/module_nst_parameters.f90 | 123 +- physics/module_nst_water_prop.f90 | 753 ++++++------ physics/sfc_nst.f | 696 ----------- physics/sfc_nst.f90 | 664 +++++++++++ physics/sfc_nst_post.f | 93 -- physics/sfc_nst_post.f90 | 87 ++ physics/sfc_nst_pre.f | 96 -- physics/sfc_nst_pre.f90 | 89 ++ 9 files changed, 2171 insertions(+), 2233 deletions(-) delete mode 100644 physics/sfc_nst.f create mode 100644 physics/sfc_nst.f90 delete mode 100644 physics/sfc_nst_post.f create mode 100644 physics/sfc_nst_post.f90 delete mode 100644 physics/sfc_nst_pre.f create mode 100644 physics/sfc_nst_pre.f90 diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index d47ab838b..74c75924b 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -10,963 +10,960 @@ !> This module contains the diurnal thermocline layer model (DTM) of !! the GFS NSST scheme. module nst_module + ! + ! the module of diurnal thermocline layer model + ! + use machine , only : kind_phys + use module_nst_parameters , only : z_w_max, z_w_min, z_w_ini, eps_z_w, eps_conv + use module_nst_parameters , only : eps_sfs, niter_z_w, niter_conv, niter_sfs, ri_c + use module_nst_parameters , only : ri_g, omg_m, omg_sh, kw => tc_w, visw, t0k, cp_w + use module_nst_parameters , only : z_c_max, z_c_ini, ustar_a_min, delz, exp_const + use module_nst_parameters , only : rad2deg, const_rot, tw_max, sst_max + use module_nst_parameters , only : zero, one + use module_nst_water_prop , only : sw_rad_skin, sw_ps_9b, sw_ps_9b_aw + + implicit none + + private + + public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth + public :: cal_w, cal_ttop, cool_skin, dtl_reset + +contains + + !>\ingroup gfs_nst_main_mod + !! This subroutine contains the module of diurnal thermocline layer model. + subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& + hl_ts,rho,alpha,beta,alon,sinlat,soltim,& + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critical ri (flow dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! sinlat : sine (lat) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d-conv : fcl thickness + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + ! + ! logical lprnt + + ! if (lprnt) print *,' first xt=',xt + if ( xt <= zero ) then ! dtl doesn't exist yet + call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + elseif ( xt > zero ) then ! dtl already exists + ! + ! forward the system one time step + ! + call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + endif ! if ( xt == 0 ) then + + end subroutine dtm_1p + + !>\ingroup gfs_nst_main_mod + !! This subroutine integrates one time step with modified Euler method. + subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + ! + ! subroutine eulerm: integrate one time step with modified euler method + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim, & + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 + real(kind=kind_phys) :: fw,aw,q_warm + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1,xzts1,xtts1 + real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 + real(kind=kind_phys) :: dzw,drho,fc + real(kind=kind_phys) :: alat,speed + ! logical lprnt + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critial ri (flow/mass dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude (deg) + ! sinlat : sine (lat) + ! soltim : solar time + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d_conv : fcl thickness (m) + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + + xt0 = xt + xs0 = xs + xu0 = xu + xv0 = xv + xz0 = xz + xtts0 = xtts + xzts0 = xzts + speed = max(1.0e-8, xu0*xu0+xv0*xv0) + + alat = asin(sinlat)*rad2deg + + fc = const_rot*sinlat + + call sw_ps_9b(xz0,fw) + + q_warm = fw*i0-q !total heat abs in warm layer + + call sw_ps_9b_aw(xz0,aw) + + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + + ! dzw = xz0*(tox*xu0+toy*xv0) / (rho*(xu0*xu0+xv0*xv0)) & + ! + xz0*xz0*xz0*drho*grav / (4.0*rich*(xu0*xu0+xv0*xv0)) + dzw = xz0 * ((tox*xu0+toy*xv0) / (rho*speed) & + + xz0*xz0*drho*grav / (4.0*rich*speed)) + + xt1 = xt0 + timestep*q_warm/(rho*cp_w) + xs1 = xs0 + timestep*sep + xu1 = xu0 + timestep*(fc*xv0+tox/rho) + xv1 = xv0 + timestep*(-fc*xu0+toy/rho) + xz1 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & + ! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich + + if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif -! -! the module of diurnal thermocline layer model -! - use machine , only : kind_phys - use module_nst_parameters, only: z_w_max,z_w_min,z_w_ini,eps_z_w,eps_conv, & - eps_sfs,niter_z_w,niter_conv,niter_sfs,ri_c, & - ri_g,omg_m,omg_sh, kw => tc_w,visw,t0k,cp_w, & - z_c_max,z_c_ini,ustar_a_min,delz,exp_const, & - rad2deg,const_rot,tw_max,sst_max - use module_nst_water_prop, only: sw_rad_skin,sw_ps_9b,sw_ps_9b_aw - implicit none - - private - - integer, parameter :: kp = kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth - public :: cal_w, cal_ttop, cool_skin, dtl_reset + ! call dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt1,xs1,xu1,xv1,xz1,tr_mda,tr_fca,tr_tla,tr_mwa) - contains + xzts1 = xzts0 + timestep*((1.0/(xu0*xu0+xv0*xv0)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz0**3/(4.0*rich*rho) & + +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & + *grav*xz0*xz0/(4.0*rich) )*xzts0 )) + xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) -!>\ingroup gfs_nst_main_mod -!! This subroutine contains the module of diurnal thermocline layer model. - subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & - alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) + ! if ( 2.0*xt1/xz1 > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te + ! endif - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,& - grav,le,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts -! local variables - -! -! input variables -! -! timestep: integration time step in seconds -! rich : critical ri (flow dependent) -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! sinlat : sine (lat) -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! d-conv : fcl thickness -! -! inout variables -! -! xt : dtl heat content (m*k) -! xs : dtl salinity content (m*ppt) -! xu : dtl x current content (m*m/s) -! xv : dtl y current content (m*m/s) -! xz : dtl thickness (m) -! xzts : d(xz)/d(ts) (m/k ) -! xtts : d(xt)/d(ts) (m) -! -! logical lprnt - -! if (lprnt) print *,' first xt=',xt - if ( xt <= zero ) then ! dtl doesn't exist yet - call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& - beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) - elseif ( xt > zero ) then ! dtl already exists -! -! forward the system one time step -! - call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & - beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) - endif ! if ( xt == 0 ) then - - end subroutine dtm_1p + call sw_ps_9b(xz1,fw) + q_warm = fw*i0-q !total heat abs in warm layer + call sw_ps_9b_aw(xz1,aw) + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + dzw = xz1*(tox*xu1+toy*xv1) / (rho*(xu1*xu1+xv1*xv1)) & + + xz1*xz1*xz1*drho*grav / (4.0*rich*(xu1*xu1+xv1*xv1)) + + xt2 = xt0 + timestep*q_warm/(rho*cp_w) + xs2 = xs0 + timestep*sep + xu2 = xu0 + timestep*(fc*xv1+tox/rho) + xv2 = xv0 + timestep*(-fc*xu1+toy/rho) + xz2 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 + + if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine integrates one time step with modified Euler method. - subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& - beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) + xzts2 = xzts0 + timestep*((1.0/(xu1*xu1+xv1*xv1)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz1**3/(4.0*rich*rho) & + +( (tox*xu1+toy*xv1)/rho+(3.0*drho-alpha*i0*aw*xz1/(rho*cp_w))* & + grav*xz1*xz1/(4.0*rich) )*xzts1 )) + xtts2 = xtts0 + timestep*(i0*aw*xzts1-q_ts)/(rho*cp_w) + + xt = 0.5*(xt1 + xt2) + xs = 0.5*(xs1 + xs2) + xu = 0.5*(xu1 + xu2) + xv = 0.5*(xv1 + xv2) + xz = 0.5*(xz1 + xz2) + xzts = 0.5*(xzts1 + xzts2) + xtts = 0.5*(xtts1 + xtts2) + + if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + endif -! -! subroutine eulerm: integrate one time step with modified euler method -! - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,& - grav,le,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts -! local variables - real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 - real(kind=kind_phys) :: fw,aw,q_warm - real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1,xzts1,xtts1 - real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 - real(kind=kind_phys) :: dzw,drho,fc - real(kind=kind_phys) :: alat,speed -! logical lprnt - -! -! input variables -! -! timestep: integration time step in seconds -! rich : critial ri (flow/mass dependent) -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! alon : longitude (deg) -! sinlat : sine (lat) -! soltim : solar time -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! d_conv : fcl thickness (m) -! -! inout variables -! -! xt : dtl heat content (m*k) -! xs : dtl salinity content (m*ppt) -! xu : dtl x current content (m*m/s) -! xv : dtl y current content (m*m/s) -! xz : dtl thickness (m) -! xzts : d(xz)/d(ts) (m/k ) -! xtts : d(xt)/d(ts) (m) - - xt0 = xt - xs0 = xs - xu0 = xu - xv0 = xv - xz0 = xz - xtts0 = xtts - xzts0 = xzts - speed = max(1.0e-8, xu0*xu0+xv0*xv0) - - alat = asin(sinlat)*rad2deg - - fc = const_rot*sinlat - - call sw_ps_9b(xz0,fw) - - q_warm = fw*i0-q !total heat abs in warm layer - - call sw_ps_9b_aw(xz0,aw) - - drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep - -! dzw = xz0*(tox*xu0+toy*xv0) / (rho*(xu0*xu0+xv0*xv0)) & -! + xz0*xz0*xz0*drho*grav / (4.0*rich*(xu0*xu0+xv0*xv0)) - dzw = xz0 * ((tox*xu0+toy*xv0) / (rho*speed) & - + xz0*xz0*drho*grav / (4.0*rich*speed)) - - xt1 = xt0 + timestep*q_warm/(rho*cp_w) - xs1 = xs0 + timestep*sep - xu1 = xu0 + timestep*(fc*xv0+tox/rho) - xv1 = xv0 + timestep*(-fc*xu0+toy/rho) - xz1 = xz0 + timestep*dzw - -! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & -! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich - - if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - return - endif - -! call dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt1,xs1,xu1,xv1,xz1,tr_mda,tr_fca,tr_tla,tr_mwa) - - xzts1 = xzts0 + timestep*((1.0/(xu0*xu0+xv0*xv0)) * & - ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz0**3/(4.0*rich*rho)& - +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & - *grav*xz0*xz0/(4.0*rich) )*xzts0 )) - xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) - -! if ( 2.0*xt1/xz1 > 0.001 ) then -! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& -! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te -! endif - - call sw_ps_9b(xz1,fw) - q_warm = fw*i0-q !total heat abs in warm layer - call sw_ps_9b_aw(xz1,aw) - drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep - dzw = xz1*(tox*xu1+toy*xv1) / (rho*(xu1*xu1+xv1*xv1)) & - + xz1*xz1*xz1*drho*grav / (4.0*rich*(xu1*xu1+xv1*xv1)) - - xt2 = xt0 + timestep*q_warm/(rho*cp_w) - xs2 = xs0 + timestep*sep - xu2 = xu0 + timestep*(fc*xv1+tox/rho) - xv2 = xv0 + timestep*(-fc*xu1+toy/rho) - xz2 = xz0 + timestep*dzw - -! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 - - if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + ! if (lprnt) print *,' xt=',xt,' xz=',xz + ! if ( 2.0*xt/xz > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_02 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt/xz,2.0*xs/xz,2.0*xu/xz,2.0*xv/xz,xz,xtts,xzts,d_conv,t_fcl,te + ! endif return - endif - - xzts2 = xzts0 + timestep*((1.0/(xu1*xu1+xv1*xv1)) * & - ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz1**3/(4.0*rich*rho)& - +( (tox*xu1+toy*xv1)/rho+(3.0*drho-alpha*i0*aw*xz1/(rho*cp_w))* & - grav*xz1*xz1/(4.0*rich) )*xzts1 )) - xtts2 = xtts0 + timestep*(i0*aw*xzts1-q_ts)/(rho*cp_w) - - xt = 0.5*(xt1 + xt2) - xs = 0.5*(xs1 + xs2) - xu = 0.5*(xu1 + xu2) - xv = 0.5*(xv1 + xv2) - xz = 0.5*(xz1 + xz2) - xzts = 0.5*(xzts1 + xzts2) - xtts = 0.5*(xtts1 + xtts2) - - if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - endif - -! if (lprnt) print *,' xt=',xt,' xz=',xz -! if ( 2.0*xt/xz > 0.001 ) then -! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_02 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& -! 2.0*xt/xz,2.0*xs/xz,2.0*xu/xz,2.0*xv/xz,xz,xtts,xzts,d_conv,t_fcl,te -! endif - return - - end subroutine eulerm -!>\ingroup gfs_nst_main_mod -!! This subroutine applies xz adjustment. - subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca,tr_tla,tr_mwa) -! apply xz adjustment: minimum depth adjustment (mda) -! free convection adjustment (fca); -! top layer adjustment (tla); -! maximum warming adjustment (mwa) -! - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz - real(kind=kind_phys), intent(out) :: tr_mda,tr_fca,tr_tla,tr_mwa -! local variables - real(kind=kind_phys) :: dz,t0,ttop0,ttop,fw,q_warm - real(kind=kind_phys) :: xz_fca,xz_tla,xz_mwa -! - real(kind=kind_phys) xz_mda - - tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero - -! apply mda - if ( z_w_min > xz ) then - xz_mda = z_w_min - endif -! apply fca - if ( d_conv > zero ) then - xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) - tr_fca = 1.0 - if ( xz_fca >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 - endif - endif -! apply tla - dz = min(xz,max(d_conv,delz)) - call sw_ps_9b(dz,fw) - q_warm=fw*i0-q !total heat abs in warm layer - - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) -! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) - ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) - if ( ttop > ttop0 ) then - xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 - tr_tla = 1.0 - if ( xz_tla >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 + end subroutine eulerm + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies xz adjustment. + subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca,tr_tla,tr_mwa) + ! apply xz adjustment: minimum depth adjustment (mda) + ! free convection adjustment (fca); + ! top layer adjustment (tla); + ! maximum warming adjustment (mwa) + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + real(kind=kind_phys), intent(out) :: tr_mda,tr_fca,tr_tla,tr_mwa + ! local variables + real(kind=kind_phys) :: dz,t0,ttop0,ttop,fw,q_warm + ! TODO: xz_mwa is unset but used below in max function + real(kind=kind_phys) :: xz_fca,xz_tla,xz_mwa + ! + real(kind=kind_phys) :: xz_mda + + tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero + + ! apply mda + if ( z_w_min > xz ) then + xz_mda = z_w_min + endif + ! apply fca + if ( d_conv > zero ) then + xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) + tr_fca = 1.0 + if ( xz_fca >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 endif - endif - endif - -! apply mwa - t0 = 2.0*xt/xz - if ( t0 > tw_max ) then - if ( xz >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 - endif - endif - - xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) - - 10 continue - - end subroutine dtm_1p_zwa + endif + ! apply tla + dz = min(xz,max(d_conv,delz)) + call sw_ps_9b(dz,fw) + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod -!! This subroutine applies free convection adjustment(fca). - subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) - -! apply xz adjustment: free convection adjustment (fca); -! - real(kind=kind_phys), intent(in) :: d_conv,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: t_fcl,t0 -! - t0 = 2.0*xt/xz - t_fcl = t0*(1.0-d_conv/(2.0*xz)) - xz = 2.0*xt/t_fcl -! xzts = 2.0*xtts/t_fcl - - end subroutine dtm_1p_fca + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) + ! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) + ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) + if ( ttop > ttop0 ) then + xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 + tr_tla = 1.0 + if ( xz_tla >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine applies top layer adjustment (tla). - subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) - -! apply xz adjustment: top layer adjustment (tla); -! - real(kind=kind_phys), intent(in) :: dz,te,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) tem -! - tem = xt*(xt-dz*te) - if (tem > zero) then - xz = (xt+sqrt(xt*(xt-dz*te)))/te - else - xz = z_w_max - endif -! xzts = xtts*(1.0+0.5*(2.0*xt-dz*te)/sqrt(xt*(xt-dz*te)))/te - end subroutine dtm_1p_tla + ! apply mwa + t0 = 2.0*xt/xz + if ( t0 > tw_max ) then + if ( xz >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine applies maximum warming adjustment (mwa). - subroutine dtm_1p_mwa(xt,xtts,xz,xzts) - -! apply xz adjustment: maximum warming adjustment (mwa) -! - real(kind=kind_phys), intent(in) :: xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables -! - xz = 2.0*xt/tw_max -! xzts = 2.0*xtts/tw_max - end subroutine dtm_1p_mwa + xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) + +10 continue + + end subroutine dtm_1p_zwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies free convection adjustment(fca). + subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) + + ! apply xz adjustment: free convection adjustment (fca); + ! + real(kind=kind_phys), intent(in) :: d_conv,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: t_fcl,t0 + ! + t0 = 2.0*xt/xz + t_fcl = t0*(1.0-d_conv/(2.0*xz)) + xz = 2.0*xt/t_fcl + ! xzts = 2.0*xtts/t_fcl + + end subroutine dtm_1p_fca + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies top layer adjustment (tla). + subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) + + ! apply xz adjustment: top layer adjustment (tla); + ! + real(kind=kind_phys), intent(in) :: dz,te,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: tem + ! + tem = xt*(xt-dz*te) + if (tem > zero) then + xz = (xt+sqrt(xt*(xt-dz*te)))/te + else + xz = z_w_max + endif + ! xzts = xtts*(1.0+0.5*(2.0*xt-dz*te)/sqrt(xt*(xt-dz*te)))/te + end subroutine dtm_1p_tla + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum warming adjustment (mwa). + subroutine dtm_1p_mwa(xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum warming adjustment (mwa) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + ! + xz = 2.0*xt/tw_max + ! xzts = 2.0*xtts/tw_max + end subroutine dtm_1p_mwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies minimum depth adjustment (xz adjustment). + subroutine dtm_1p_mda(xt,xtts,xz,xzts) + + ! apply xz adjustment: minimum depth adjustment (mda) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + xz = max(z_w_min,xz) + ta = 2.0*xt/xz + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mda + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum temperature adjustment (mta). + subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum temperature adjustment (mta) + ! + real(kind=kind_phys), intent(in) :: dta,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + ta = max(zero,2.0*xt/xz-dta) + if ( ta > zero ) then + xz = 2.0*xt/ta + else + xz = z_w_max + endif + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mta + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates depth for convective adjustment. + subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) + + ! + ! calculate depth for convective adjustment + ! + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,sss,sep,rho,alpha,beta + real(kind=kind_phys), intent(in) :: xt,xs,xz + real(kind=kind_phys), intent(out) :: d_conv + real(kind=kind_phys) :: t,s,d_conv_ini,d_conv2,fxp,aw,s1,s2,fac1 + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! xt : initial heat content (k*m) + ! xs : initial salinity content (ppt*m) + ! xz : initial dtl thickness (m) + ! + ! output variables + ! + ! d_conv : free convection depth (m) + + ! t : initial diurnal warming t (k) + ! s : initial diurnal warming s (ppt) + + n = 0 + t = 2.0*xt/xz + s = 2.0*xs/xz + + s1 = alpha*rho*t-omg_m*beta*rho*s + + if ( s1 == zero ) then + d_conv = zero + else -!>\ingroup gfs_nst_main_mod -!! This subroutine applies minimum depth adjustment (xz adjustment). - subroutine dtm_1p_mda(xt,xtts,xz,xzts) - -! apply xz adjustment: minimum depth adjustment (mda) -! - real(kind=kind_phys), intent(in) :: xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: ta -! - xz = max(z_w_min,xz) - ta = 2.0*xt/xz -! xzts = 2.0*xtts/ta - - end subroutine dtm_1p_mda + fac1 = alpha*q/cp_w+omg_m*beta*rho*sep + if ( i0 <= zero ) then + d_conv2=(2.0*xz*timestep/s1)*fac1 + if ( d_conv2 > zero ) then + d_conv = sqrt(d_conv2) + else + d_conv = zero + endif + elseif ( i0 > zero ) then + + d_conv_ini = zero + + iter_conv: do n = 1, niter_conv + call sw_ps_9b(d_conv_ini,fxp) + call sw_ps_9b_aw(d_conv_ini,aw) + s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep + d_conv2=(2.0*xz*timestep/s1)*s2 + if ( d_conv2 < zero ) then + d_conv = zero + exit iter_conv + endif + d_conv = sqrt(d_conv2) + if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv + d_conv_ini = d_conv + enddo iter_conv + d_conv = max(zero,min(d_conv,z_w_max)) + endif ! if ( i0 <= zero ) then + + endif ! if ( s1 == zero ) then + + ! if ( d_conv > 0.01 ) then + ! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & + ! s1,s2,d_conv2,aw + ! endif + + end subroutine convdepth + + !>\ingroup gfs_nst_main_mod + subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + ! + ! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables + ! + + integer,intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le + real(kind=kind_phys), intent(out) :: xt,xs,xu,xv,xz,xzts,xtts + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0 + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1 + real(kind=kind_phys) :: fw,aw,q_warm,ft0,fs0,fu0,fv0,fz0,ft1,fs1,fu1,fv1,fz1 + real(kind=kind_phys) :: coeff1,coeff2,ftime,z_w,z_w_tmp,fc,warml,alat + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude + ! sinlat : sine(latitude) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! + ! output variables + ! + ! xt : onset t content in dtl + ! xs : onset s content in dtl + ! xu : onset u content in dtl + ! xv : onset v content in dtl + ! xz : onset dtl thickness (m) + ! xzts : onset d(xz)/d(ts) (m/k ) + ! xtts : onset d(xt)/d(ts) (m) + + fc=1.46/10000.0/2.0*sinlat + alat = asin(sinlat) + ! + ! initializing dtl (just before the onset) + ! + xt0 = zero + xs0 = zero + xu0 = zero + xv0 = zero + + z_w_tmp=z_w_ini + + call sw_ps_9b(z_w_tmp,fw) + ! fw=0.5 ! + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod -!! This subroutine applies maximum temperature adjustment (mta). - subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) - -! apply xz adjustment: maximum temperature adjustment (mta) -! - real(kind=kind_phys), intent(in) :: dta,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: ta -! - ta = max(zero,2.0*xt/xz-dta) - if ( ta > zero ) then - xz = 2.0*xt/ta - else - xz = z_w_max - endif -! xzts = 2.0*xtts/ta - - end subroutine dtm_1p_mta + if ( abs(alat) > 1.0 ) then + ftime=sqrt((2.0-2.0*cos(fc*timestep))/(fc*fc*timestep)) + else + ftime=timestep + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates depth for convective adjustment. -subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) - -! -! calculate depth for convective adjustment -! - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,i0,q,sss,sep,rho,alpha,beta - real(kind=kind_phys), intent(in) :: xt,xs,xz - real(kind=kind_phys), intent(out) :: d_conv - real(kind=kind_phys) :: t,s,d_conv_ini,d_conv2,fxp,aw,s1,s2,fac1 - integer :: n -! -! input variables -! -! timestep: time step in seconds -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! xt : initial heat content (k*m) -! xs : initial salinity content (ppt*m) -! xz : initial dtl thickness (m) -! -! output variables -! -! d_conv : free convection depth (m) - -! t : initial diurnal warming t (k) -! s : initial diurnal warming s (ppt) - - n = 0 - t = 2.0*xt/xz - s = 2.0*xs/xz - - s1 = alpha*rho*t-omg_m*beta*rho*s - - if ( s1 == zero ) then - d_conv = zero - else - - fac1 = alpha*q/cp_w+omg_m*beta*rho*sep - if ( i0 <= zero ) then - d_conv2=(2.0*xz*timestep/s1)*fac1 - if ( d_conv2 > zero ) then - d_conv = sqrt(d_conv2) - else - d_conv = zero - endif - elseif ( i0 > zero ) then - - d_conv_ini = zero - - iter_conv: do n = 1, niter_conv - call sw_ps_9b(d_conv_ini,fxp) - call sw_ps_9b_aw(d_conv_ini,aw) - s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep - d_conv2=(2.0*xz*timestep/s1)*s2 - if ( d_conv2 < zero ) then - d_conv = zero - exit iter_conv - endif - d_conv = sqrt(d_conv2) - if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv - d_conv_ini = d_conv - enddo iter_conv - d_conv = max(zero,min(d_conv,z_w_max)) - endif ! if ( i0 <= zero ) then + coeff1=alpha*grav/cp_w + coeff2=omg_m*beta*grav*rho + warml = coeff1*q_warm-coeff2*sep + + if ( warml > zero .and. q_warm > zero) then + iters_z_w: do n = 1,niter_z_w + if ( warml > zero .and. q_warm > zero ) then + z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) + else + z_w = z_w_max + exit iters_z_w + endif + + ! write(*,'(a,i4,i4,10f9.3,f9.6,f3.0)') ' z_w = ',kdt,n,z_w,z_w_tmp,timestep,q_warm,q,i0,fw,tox,toy,sep,warml,omg_m + + if (abs(z_w - z_w_tmp) < eps_z_w .and. z_w/=z_w_max .and. n < niter_z_w) exit iters_z_w + z_w_tmp=z_w + call sw_ps_9b(z_w_tmp,fw) + q_warm = fw*i0-q + warml = coeff1*q_warm-coeff2*sep + end do iters_z_w + else + z_w=z_w_max + endif - endif ! if ( s1 == zero ) then + xz0 = max(z_w,z_w_min) -! if ( d_conv > 0.01 ) then -! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & -! s1,s2,d_conv2,aw -! endif + ! + ! update xt, xs, xu, xv + ! + if ( z_w < z_w_max .and. q_warm > zero) then - end subroutine convdepth + call sw_ps_9b(z_w,fw) + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod - subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & - alpha,beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) -! -! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables -! - - integer,intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le - real(kind=kind_phys), intent(out) :: xt,xs,xu,xv,xz,xzts,xtts - real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0 - real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1 - real(kind=kind_phys) :: fw,aw,q_warm,ft0,fs0,fu0,fv0,fz0,ft1,fs1,fu1,fv1,fz1 - real(kind=kind_phys) :: coeff1,coeff2,ftime,z_w,z_w_tmp,fc,warml,alat - integer :: n -! -! input variables -! -! timestep: time step in seconds -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! alon : longitude -! sinlat : sine(latitude) -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! -! output variables -! -! xt : onset t content in dtl -! xs : onset s content in dtl -! xu : onset u content in dtl -! xv : onset v content in dtl -! xz : onset dtl thickness (m) -! xzts : onset d(xz)/d(ts) (m/k ) -! xtts : onset d(xt)/d(ts) (m) - - fc=1.46/10000.0/2.0*sinlat - alat = asin(sinlat) -! -! initializing dtl (just before the onset) -! - xt0 = zero - xs0 = zero - xu0 = zero - xv0 = zero - - z_w_tmp=z_w_ini - - call sw_ps_9b(z_w_tmp,fw) -! fw=0.5 ! - q_warm=fw*i0-q !total heat abs in warm layer - - if ( abs(alat) > 1.0 ) then - ftime=sqrt((2.0-2.0*cos(fc*timestep))/(fc*fc*timestep)) - else - ftime=timestep - endif - - coeff1=alpha*grav/cp_w - coeff2=omg_m*beta*grav*rho - warml = coeff1*q_warm-coeff2*sep - - if ( warml > zero .and. q_warm > zero) then - iters_z_w: do n = 1,niter_z_w - if ( warml > zero .and. q_warm > zero ) then - z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) - else - z_w = z_w_max - exit iters_z_w - endif - -! write(*,'(a,i4,i4,10f9.3,f9.6,f3.0)') ' z_w = ',kdt,n,z_w,z_w_tmp,timestep,q_warm,q,i0,fw,tox,toy,sep,warml,omg_m - - if (abs(z_w - z_w_tmp) < eps_z_w .and. z_w/=z_w_max .and. n < niter_z_w) exit iters_z_w - z_w_tmp=z_w - call sw_ps_9b(z_w_tmp,fw) - q_warm = fw*i0-q - warml = coeff1*q_warm-coeff2*sep - end do iters_z_w - else - z_w=z_w_max - endif - - xz0 = max(z_w,z_w_min) - -! -! update xt, xs, xu, xv -! - if ( z_w < z_w_max .and. q_warm > zero) then - - call sw_ps_9b(z_w,fw) - q_warm=fw*i0-q !total heat abs in warm layer + ft0 = q_warm/(rho*cp_w) + fs0 = sep + fu0 = fc*xv0+tox/rho + fv0 = -fc*xu0+toy/rho - ft0 = q_warm/(rho*cp_w) - fs0 = sep - fu0 = fc*xv0+tox/rho - fv0 = -fc*xu0+toy/rho + xt1 = xt0 + timestep*ft0 + xs1 = xs0 + timestep*fs0 + xu1 = xu0 + timestep*fu0 + xv1 = xv0 + timestep*fv0 - xt1 = xt0 + timestep*ft0 - xs1 = xs0 + timestep*fs0 - xu1 = xu0 + timestep*fu0 - xv1 = xv0 + timestep*fv0 + fz0 = xz0*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz0*xz0/(4.0*rich) & + -alpha*grav*q_warm*xz0*xz0/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + xz1 = xz0 + timestep*fz0 - fz0 = xz0*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz0*xz0/(4.0*rich) & - -alpha*grav*q_warm*xz0*xz0/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) - xz1 = xz0 + timestep*fz0 + xz1 = max(xz1,z_w_min) - xz1 = max(xz1,z_w_min) + if ( xt1 < zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + return + endif - if ( xt1 < zero .or. xz1 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) - return - endif + call sw_ps_9b(xz1,fw) + q_warm=fw*i0-q !total heat abs in warm layer - call sw_ps_9b(xz1,fw) - q_warm=fw*i0-q !total heat abs in warm layer + ft1 = q_warm/(rho*cp_w) + fs1 = sep + fu1 = fc*xv1+tox/rho + fv1 = -fc*xu1+toy/rho - ft1 = q_warm/(rho*cp_w) - fs1 = sep - fu1 = fc*xv1+tox/rho - fv1 = -fc*xu1+toy/rho + fz1 = xz1*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz1*xz1/(4.0*rich) & + -alpha*grav*q_warm*xz1*xz1/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) - fz1 = xz1*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz1*xz1/(4.0*rich) & - -alpha*grav*q_warm*xz1*xz1/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + xt = xt0 + 0.5*timestep*(ft0+ft1) + xs = xs0 + 0.5*timestep*(fs0+fs1) + xu = xu0 + 0.5*timestep*(fu0+fu1) + xv = xv0 + 0.5*timestep*(fv0+fv1) + xz = xz0 + 0.5*timestep*(fz0+fz1) - xt = xt0 + 0.5*timestep*(ft0+ft1) - xs = xs0 + 0.5*timestep*(fs0+fs1) - xu = xu0 + 0.5*timestep*(fu0+fu1) - xv = xv0 + 0.5*timestep*(fv0+fv1) - xz = xz0 + 0.5*timestep*(fz0+fz1) + xz = max(xz,z_w_min) - xz = max(xz,z_w_min) + call sw_ps_9b_aw(xz,aw) - call sw_ps_9b_aw(xz,aw) + ! xzts = (q_ts+(cp_w*omg_m*beta*sss/(le*alpha))*hl_ts)*xz/(i0*xz*aw+2.0*q_warm-2.0*(rho*cp_w*omg_m*beta*sss/alpha)*(sep/sss)) + xzts = (q_ts+omg_m*rho*cp_w*beta*sss*hl_ts*xz/(le*alpha))/(i0*xz*aw+2.0*q_warm-2.0*omg_m*rho*cp_w*beta*sss*sep/(le*alpha)) + xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) + endif -! xzts = (q_ts+(cp_w*omg_m*beta*sss/(le*alpha))*hl_ts)*xz/(i0*xz*aw+2.0*q_warm-2.0*(rho*cp_w*omg_m*beta*sss/alpha)*(sep/sss)) - xzts = (q_ts+omg_m*rho*cp_w*beta*sss*hl_ts*xz/(le*alpha))/(i0*xz*aw+2.0*q_warm-2.0*omg_m*rho*cp_w*beta*sss*sep/(le*alpha)) - xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) - endif + if ( xt < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + endif - if ( xt < zero .or. xz > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) - endif + return - return + end subroutine dtm_onset + + !>\ingroup gfs_nst_main_mod + !! This subroutine computes coefficients (\a w_0 and \a w_d) to + !! calculate d(tw)/d(ts). + subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) + ! + ! abstract: calculate w_0,w_d + ! + ! input variables + ! + ! kdt : the number of time step + ! xt : dtl heat content + ! xz : dtl depth + ! xzts : d(zw)/d(ts) + ! xtts : d(xt)/d(ts) + ! + ! output variables + ! + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts + real(kind=kind_phys), intent(out) :: w_0,w_d + + w_0 = 2.0*(xtts-xt*xzts/xz)/xz + w_d = (2.0*xt*xzts/xz**2-w_0)/xz + + ! if ( 2.0*xt/xz > 1.0 ) then + ! write(*,'(a,i4,2f9.3,4f10.4))') ' cal_w : ',kdt,xz,xt,w_0,w_d,xzts,xtts + ! endif + end subroutine cal_w + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates the diurnal warming amount at the top layer + !! with thickness of \a delz. + subroutine cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop) + ! + ! abstract: calculate + ! + ! input variables + ! + ! kdt : the number of record + ! timestep : the number of record + ! q_warm : total heat abs in layer dz + ! rho : sea water density + ! dz : dz = max(delz,d_conv) top layer thickness defined to adjust xz + ! xt : heat content in dtl at previous time + ! xz : dtl thickness at previous time + ! + ! output variables + ! + ! ttop : the diurnal warming amount at the top layer with thickness of delz + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,q_warm,rho,dz,xt,xz + real(kind=kind_phys), intent(out) :: ttop + real(kind=kind_phys) :: dt_warm,t0 + + dt_warm = (xt+xt)/xz + t0 = dt_warm*(1.0-dz/(xz+xz)) + ttop = t0 + q_warm*timestep/(rho*cp_w*dz) + + end subroutine cal_ttop + + !>\ingroup gfs_nst_main_mod + !! This subroutine adjust dtm-1p dtl thickness by applying shear flow stability + !! with assumed exponential profile. + subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) + ! + ! abstract: adjust dtm-1p dtl thickness by applying shear flow stability with assumed exponetial profile + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xs : salinity content in dtl + ! xu : u-current content in dtl + ! xv : v-current content in dtl + ! alpha + ! beta + ! grav + ! d_1p : dtl depth before sfs applied + ! + ! output variables + ! + ! xz : dtl depth + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p + real(kind=kind_phys), intent(out) :: xz + ! real(kind=kind_phys) :: ze,cc,xz0,l,d_sfs, t_sfs, tem + real(kind=kind_phys) :: cc,l,d_sfs,tem + real(kind=kind_phys), parameter :: c2 = 0.3782 + + cc = ri_g/(grav*c2) + + tem = alpha*xt - beta*xs + if (tem > zero) then + d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) + else + d_sfs = zero + endif - end subroutine dtm_onset + ! xz0 = d_1p + ! iter_sfs: do n = 1, niter_sfs + ! l = int_epn(0.0,xz0,0.0,xz0,2) + ! d_sfs = cc*(xu*xu+xv*xv)/((alpha*xt-beta*xs)*l) + ! write(*,'(a,i6,i3,4f9.4))') ' app_sfs_iter : ',kdt,n,cc,l,xz0,d_sfs + ! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs + ! xz0 = d_sfs + ! enddo iter_sfs -!>\ingroup gfs_nst_main_mod -!! This subroutine computes coefficients (\a w_0 and \a w_d) to -!! calculate d(tw)/d(ts). - subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) -! -! abstract: calculate w_0,w_d -! -! input variables -! -! kdt : the number of time step -! xt : dtl heat content -! xz : dtl depth -! xzts : d(zw)/d(ts) -! xtts : d(xt)/d(ts) -! -! output variables -! -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts - real(kind=kind_phys), intent(out) :: w_0,w_d - - w_0 = 2.0*(xtts-xt*xzts/xz)/xz - w_d = (2.0*xt*xzts/xz**2-w_0)/xz - -! if ( 2.0*xt/xz > 1.0 ) then -! write(*,'(a,i4,2f9.3,4f10.4))') ' cal_w : ',kdt,xz,xt,w_0,w_d,xzts,xtts -! endif - end subroutine cal_w + ! ze = a2*d_sfs ! not used! -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates the diurnal warming amount at the top layer -!! with thickness of \a delz. - subroutine cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop) -! -! abstract: calculate -! -! input variables -! -! kdt : the number of record -! timestep : the number of record -! q_warm : total heat abs in layer dz -! rho : sea water density -! dz : dz = max(delz,d_conv) top layer thickness defined to adjust xz -! xt : heat content in dtl at previous time -! xz : dtl thickness at previous time -! -! output variables -! -! ttop : the diurnal warming amount at the top layer with thickness of delz - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,q_warm,rho,dz,xt,xz - real(kind=kind_phys), intent(out) :: ttop - real(kind=kind_phys) :: dt_warm,t0 - - dt_warm = (xt+xt)/xz - t0 = dt_warm*(1.0-dz/(xz+xz)) - ttop = t0 + q_warm*timestep/(rho*cp_w*dz) - - end subroutine cal_ttop + l = int_epn(zero,d_sfs,zero,d_sfs,2) -!>\ingroup gfs_nst_main_mod -!! This subroutine adjust dtm-1p dtl thickness by applying shear flow stability -!! with assumed exponential profile. - subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) -! -! abstract: adjust dtm-1p dtl thickness by applying shear flow stability with assumed exponetial profile -! -! input variables -! -! kdt : the number of record -! xt : heat content in dtl -! xs : salinity content in dtl -! xu : u-current content in dtl -! xv : v-current content in dtl -! alpha -! beta -! grav -! d_1p : dtl depth before sfs applied -! -! output variables -! -! xz : dtl depth - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p - real(kind=kind_phys), intent(out) :: xz -! real(kind=kind_phys) :: ze,cc,xz0,l,d_sfs, t_sfs, tem - real(kind=kind_phys) :: cc,l,d_sfs,tem - real(kind=kind_phys), parameter :: c2 = 0.3782 - integer :: n - - cc = ri_g/(grav*c2) - - tem = alpha*xt - beta*xs - if (tem > zero) then - d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) - else - d_sfs = zero - endif - -! xz0 = d_1p -! iter_sfs: do n = 1, niter_sfs -! l = int_epn(0.0,xz0,0.0,xz0,2) -! d_sfs = cc*(xu*xu+xv*xv)/((alpha*xt-beta*xs)*l) -! write(*,'(a,i6,i3,4f9.4))') ' app_sfs_iter : ',kdt,n,cc,l,xz0,d_sfs -! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs -! xz0 = d_sfs -! enddo iter_sfs - -! ze = a2*d_sfs ! not used! - - l = int_epn(zero,d_sfs,zero,d_sfs,2) - -! t_sfs = xt/l -! xz = (xt+xt) / t_sfs + ! t_sfs = xt/l + ! xz = (xt+xt) / t_sfs xz = l + l -! write(*,'(a,i6,6f9.4))') ' app_sfs : ',kdt,xz0,d_sfs,d_1p,xz,2.0*xt/d_1p,t_sfs - end subroutine app_sfs - -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates d(tz)/d(ts). - subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) -! -! abstract: calculate d(tz)/d(ts) -! -! input variables -! -! kdt : the number of record -! xt : heat content in dtl -! xz : dtl depth (m) -! c_0 : coefficint 1 to calculate d(tc)/d(ts) -! c_d : coefficint 2 to calculate d(tc)/d(ts) -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) -! -! output variables -! -! tztr : d(tz)/d(tr) - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z - real(kind=kind_phys), intent(out) :: tztr - - if ( xt > zero ) then - if ( z <= zc ) then -! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) - tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) - elseif ( z > zc .and. z < zw ) then -! tztr = (1.0+c_0)/(1.0-w_0+c_0)+z*w_d/(1.0-w_0+c_0) - tztr = (1.0+c_0+z*w_d)/(1.0-w_0+c_0) - elseif ( z >= zw ) then - tztr = 1.0 - endif - elseif ( xt == zero ) then - if ( z <= zc ) then -! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) - tztr = (1.0-z*c_d)/(1.0+c_0) - else + ! write(*,'(a,i6,6f9.4))') ' app_sfs : ',kdt,xz0,d_sfs,d_1p,xz,2.0*xt/d_1p,t_sfs + end subroutine app_sfs + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates d(tz)/d(ts). + subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) + ! + ! abstract: calculate d(tz)/d(ts) + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xz : dtl depth (m) + ! c_0 : coefficint 1 to calculate d(tc)/d(ts) + ! c_d : coefficint 2 to calculate d(tc)/d(ts) + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + ! + ! output variables + ! + ! tztr : d(tz)/d(tr) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z + real(kind=kind_phys), intent(out) :: tztr + + if ( xt > zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) + tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) + elseif ( z > zc .and. z < zw ) then + ! tztr = (1.0+c_0)/(1.0-w_0+c_0)+z*w_d/(1.0-w_0+c_0) + tztr = (1.0+c_0+z*w_d)/(1.0-w_0+c_0) + elseif ( z >= zw ) then + tztr = 1.0 + endif + elseif ( xt == zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) + tztr = (1.0-z*c_d)/(1.0+c_0) + else + tztr = 1.0 + endif + else tztr = 1.0 - endif - else - tztr = 1.0 - endif - -! write(*,'(a,i4,9f9.4))') ' cal_tztr : ',kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr - end subroutine cal_tztr - -!>\ingroup gfs_nst_main_mod -!> This subroutine contains the upper ocean cool-skin parameterization -!! (Fairall et al, 1996 \cite fairall_et_al_1996). -subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) -! -! upper ocean cool-skin parameterizaion, fairall et al, 1996. -! -! input: -! ustar_a : atmosphreic friction velocity at the air-sea interface (m/s) -! f_nsol : the "nonsolar" part of the surface heat flux (w/m^s) -! f_sol_0 : solar radiation at the ocean surface (w/m^2) -! evap : latent heat flux (w/m^2) -! sss : ocean upper mixed layer salinity (ppu) -! alpha : thermal expansion coefficient -! beta : saline contraction coefficient -! rho_w : oceanic density -! rho_a : atmospheric density -! ts : oceanic surface temperature -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! grav : gravity -! le : -! -! output: -! deltat_c: cool-skin temperature correction (degrees k) -! z_c : molecular sublayer (cool-skin) thickness (m) -! c_0 : coefficient1 to calculate d(tz)/d(ts) -! c_d : coefficient2 to calculate d(tz)/d(ts) - -! - real(kind=kind_phys), intent(in) :: ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le - real(kind=kind_phys), intent(out):: deltat_c,z_c,c_0,c_d -! declare local variables - real(kind=kind_phys), parameter :: a1=0.065, a2=11.0, a3=6.6e-5, a4=8.0e-4, tcw=0.6 & - , tcwi=1.0/tcw - real(kind=kind_phys) :: a_c,b_c,zc_ts,bc1,bc2 - real(kind=kind_phys) :: xi,hb,ustar1_a,bigc,deltaf,fxp - real(kind=kind_phys) :: zcsq - real(kind=kind_phys) :: cc1,cc2,cc3 - - - z_c = z_c_ini ! initial guess - - ustar1_a = max(ustar_a,ustar_a_min) - - call sw_rad_skin(z_c,fxp) - deltaf = f_sol_0*fxp - - hb = alpha*(f_nsol-deltaf)+beta*sss*cp_w*evap/le - bigc = 16*grav*cp_w*(rho_w*visw)**3/(rho_a*rho_a*kw*kw) - - if ( hb > 0 ) then - xi = 6./(1+(bigc*hb/ustar1_a**4)**0.75)**0.3333333 - else - xi = 6.0 - endif - z_c = min(z_c_max,xi*visw/(sqrt(rho_a/rho_w)*ustar1_a )) - - call sw_rad_skin(z_c,fxp) - - deltaf = f_sol_0*fxp - deltaf = f_nsol - deltaf - if ( deltaf > 0 ) then - deltat_c = deltaf * z_c / kw - else - deltat_c = zero - z_c = zero - endif -! -! calculate c_0 & c_d -! - if ( z_c > zero ) then - cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) - cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 - cc3 = beta*sss*cp_w/(alpha*le) - zcsq = z_c * z_c - a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - - if ( hb > zero .and. zcsq > zero .and. alpha > zero) then - bc1 = zcsq * (q_ts+cc3*hl_ts) - bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) - zc_ts = bc1/bc2 -! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) - b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & - - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) - c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi - c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + endif + ! write(*,'(a,i4,9f9.4))') ' cal_tztr : ',kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr + end subroutine cal_tztr + + !>\ingroup gfs_nst_main_mod + !> This subroutine contains the upper ocean cool-skin parameterization + !! (Fairall et al, 1996 \cite fairall_et_al_1996). + subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) + ! + ! upper ocean cool-skin parameterizaion, fairall et al, 1996. + ! + ! input: + ! ustar_a : atmosphreic friction velocity at the air-sea interface (m/s) + ! f_nsol : the "nonsolar" part of the surface heat flux (w/m^s) + ! f_sol_0 : solar radiation at the ocean surface (w/m^2) + ! evap : latent heat flux (w/m^2) + ! sss : ocean upper mixed layer salinity (ppu) + ! alpha : thermal expansion coefficient + ! beta : saline contraction coefficient + ! rho_w : oceanic density + ! rho_a : atmospheric density + ! ts : oceanic surface temperature + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! grav : gravity + ! le : + ! + ! output: + ! deltat_c: cool-skin temperature correction (degrees k) + ! z_c : molecular sublayer (cool-skin) thickness (m) + ! c_0 : coefficient1 to calculate d(tz)/d(ts) + ! c_d : coefficient2 to calculate d(tz)/d(ts) + + ! + real(kind=kind_phys), intent(in) :: ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le + real(kind=kind_phys), intent(out) :: deltat_c,z_c,c_0,c_d + ! declare local variables + real(kind=kind_phys), parameter :: a1=0.065, a2=11.0, a3=6.6e-5, a4=8.0e-4, tcw=0.6, tcwi=1.0/tcw + real(kind=kind_phys) :: a_c,b_c,zc_ts,bc1,bc2 + real(kind=kind_phys) :: xi,hb,ustar1_a,bigc,deltaf,fxp + real(kind=kind_phys) :: zcsq + real(kind=kind_phys) :: cc1,cc2,cc3 + + + z_c = z_c_ini ! initial guess + + ustar1_a = max(ustar_a,ustar_a_min) + + call sw_rad_skin(z_c,fxp) + deltaf = f_sol_0*fxp + + hb = alpha*(f_nsol-deltaf)+beta*sss*cp_w*evap/le + bigc = 16*grav*cp_w*(rho_w*visw)**3/(rho_a*rho_a*kw*kw) + + if ( hb > 0 ) then + xi = 6./(1+(bigc*hb/ustar1_a**4)**0.75)**0.3333333 else - b_c = zero - zc_ts = zero - c_0 = z_c*q_ts*tcwi - c_d = -q_ts*tcwi + xi = 6.0 endif + z_c = min(z_c_max,xi*visw/(sqrt(rho_a/rho_w)*ustar1_a )) -! if ( c_0 < 0.0 ) then -! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 -! endif + call sw_rad_skin(z_c,fxp) -! c_0 = z_c*q_ts/tcw -! c_d = -q_ts/tcw + deltaf = f_sol_0*fxp + deltaf = f_nsol - deltaf + if ( deltaf > 0 ) then + deltat_c = deltaf * z_c / kw + else + deltat_c = zero + z_c = zero + endif + ! + ! calculate c_0 & c_d + ! + if ( z_c > zero ) then + cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) + cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 + cc3 = beta*sss*cp_w/(alpha*le) + zcsq = z_c * z_c + a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) + + if ( hb > zero .and. zcsq > zero .and. alpha > zero) then + bc1 = zcsq * (q_ts+cc3*hl_ts) + bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) + zc_ts = bc1/bc2 + ! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) + b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & + - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) + c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi + c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + + else + b_c = zero + zc_ts = zero + c_0 = z_c*q_ts*tcwi + c_d = -q_ts*tcwi + endif - else - c_0 = zero - c_d = zero - endif ! if ( z_c > 0.0 ) then + ! if ( c_0 < 0.0 ) then + ! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 + ! endif - end subroutine cool_skin -! -!====================== -! -!>\ingroup gfs_nst_main_mod -!! This function calculates a definitive integral of an exponential curve (power of 2). - real function int_epn(z1,z2,zmx,ztr,n) -! -! abstract: calculate a definitive integral of an exponetial curve (power of 2) -! - real(kind_phys) :: z1,z2,zmx,ztr,zi - real(kind_phys) :: fa,fb,fi,int - integer :: m,i,n - - m = nint((z2-z1)/delz) - fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) - fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) - int = zero - do i = 1, m-1 - zi = z1 + delz*float(i) - fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) - int = int + fi - enddo - int_epn = delz*((fa+fb)/2.0 + int) - end function int_epn + ! c_0 = z_c*q_ts/tcw + ! c_d = -q_ts/tcw -!>\ingroup gfs_nst_main_mod -!! This subroutine resets the value of xt,xs,xu,xv,xz. - subroutine dtl_reset_cv(xt,xs,xu,xv,xz) - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + else + c_0 = zero + c_d = zero + endif ! if ( z_c > 0.0 ) then + + end subroutine cool_skin + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This function calculates a definitive integral of an exponential curve (power of 2). + real function int_epn(z1,z2,zmx,ztr,n) + ! + ! abstract: calculate a definitive integral of an exponetial curve (power of 2) + ! + real(kind_phys) :: z1,z2,zmx,ztr,zi + real(kind_phys) :: fa,fb,fi,int + integer :: m,i,n + + m = nint((z2-z1)/delz) + fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) + fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) + int = zero + do i = 1, m-1 + zi = z1 + delz*float(i) + fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) + int = int + fi + enddo + int_epn = delz*((fa+fb)/2.0 + int) + end function int_epn + + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz. + subroutine dtl_reset_cv(xt,xs,xu,xv,xz) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz xt = zero xs = zero xu = zero xv = zero xz = z_w_max - end subroutine dtl_reset_cv + end subroutine dtl_reset_cv -!>\ingroup gfs_nst_main_mod -!! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. - subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. + subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts xt = zero xs = zero xu = zero @@ -974,6 +971,6 @@ subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) xz = z_w_max xtts = zero xzts = zero - end subroutine dtl_reset + end subroutine dtl_reset end module nst_module diff --git a/physics/module_nst_parameters.f90 b/physics/module_nst_parameters.f90 index 1e1a39ca1..5308345e2 100644 --- a/physics/module_nst_parameters.f90 +++ b/physics/module_nst_parameters.f90 @@ -9,70 +9,83 @@ !! history: !! 20210305: X.Li, reduce z_w_max from 30 m to 20 m module module_nst_parameters + use machine, only : kind_phys ! ! air constants and coefficients from the atmospehric model - use physcons, only: & - eps => con_eps & !< con_rd/con_rv (nd) - ,cp_a => con_cp & !< spec heat air @p (j/kg/k) - ,epsm1 => con_epsm1 & !< eps - 1 (nd) - ,hvap => con_hvap & !< lat heat h2o cond (j/kg) - ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) - ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) - ,omega => con_omega & !< ang vel of earth (1/s) - ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) - ,rd => con_rd & !< gas constant air (j/kg/k) - ,rocp => con_rocp & !< r/cp - ,pi => con_pi + use physcons, only: & + eps => con_eps & !< con_rd/con_rv (nd) + ,cp_a => con_cp & !< spec heat air @p (j/kg/k) + ,epsm1 => con_epsm1 & !< eps - 1 (nd) + ,hvap => con_hvap & !< lat heat h2o cond (j/kg) + ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) + ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) + ,omega => con_omega & !< ang vel of earth (1/s) + ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) + ,rd => con_rd & !< gas constant air (j/kg/k) + ,rocp => con_rocp & !< r/cp + ,pi => con_pi + + implicit none + + private + + public :: sigma_r + public :: zero, one, half + public :: niter_conv, niter_z_w, niter_sfs + public :: z_w_max, z_w_min, z_w_ini, z_c_max, z_c_ini, eps_z_w, eps_conv, eps_sfs + public :: ri_c, ri_g, omg_m, omg_sh, tc_w, visw, cp_w, t0k, ustar_a_min, delz, exp_const + public :: rad2deg, const_rot, tw_max, sst_max, solar_time_6am, tau_min, wd_max + + real(kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, half = 0.5_kind_phys ! ! note: take timestep from here later - public integer :: & niter_conv = 5, & niter_z_w = 5, & niter_sfs = 5 - real (kind=kind_phys), parameter :: & - ! - ! general constants - sec_in_day=86400. & - ,sec_in_hour=3600. & - ,solar_time_6am=21600.0 & - ,const_rot=0.000073 & !< constant to calculate corioli force - ,ri_c=0.65 & - ,ri_g=0.25 & - ,eps_z_w=0.01 & !< criteria to finish iterations for z_w - ,eps_conv=0.01 & !< criteria to finish iterations for d_conv - ,eps_sfs=0.01 & !< criteria to finish iterations for d_sfs - ,z_w_max=20.0 & !< max warm layer thickness - ,z_w_min=0.2 & !< min warm layer thickness - ,z_w_ini=0.2 & !< initial warm layer thickness in dtl_onset - ,z_c_max=0.01 & !< maximum of sub-layer thickness (m) - ,z_c_ini=0.001 & !< initial value of z_c - ,ustar_a_min=0.031 & !< minimum of friction wind speed (m/s): 0.031 ~ 1m/s at 10 m hight - ,tau_min=0.005 & !< minimum of wind stress for dtm - ,exp_const=9.5 & !< coefficient in exponet profile - ,delz=0.1 & !< vertical increment for integral calculation (m) - ,von=0.4 & !< von karman's "constant" - ,t0k=273.16 & !< celsius to kelvin - ,gray=0.97 & - ,sst_max=308.16 & - ,tw_max=5.0 & - ,wd_max=2.0 & - ,omg_m =1.0 & !< trace factor to apply salinity effect - ,omg_rot = 1.0 & !< trace factor to apply rotation effect - ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect - ,visw=1.e-6 & !< m2/s kinematic viscosity water - ,novalue=0 & - ,smallnumber=1.e-6 & - ,timestep_oc=sec_in_day/8. & !< time step in the ocean model (3 hours) - ,radian=2.*pi/180. & - ,rad2deg=180./pi & - ,cp_w=4000. & !< specific heat water (j/kg/k ) - ,rho0_w=1022.0 & !< density water (kg/m3 ) (or 1024.438) - ,vis_w=1.e-6 & !< kinematic viscosity water (m2/s ) - ,tc_w=0.6 & !< thermal conductivity water (w/m/k ) - ,capa_w =3950.0 & !< heat capacity of sea water ! - ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) + ! + ! general constants + real (kind=kind_phys), parameter :: & + sec_in_day = 86400. & + ,sec_in_hour = 3600. & + ,solar_time_6am = 21600.0 & + ,const_rot = 0.000073 & !< constant to calculate corioli force + ,ri_c = 0.65 & + ,ri_g = 0.25 & + ,eps_z_w = 0.01 & !< criteria to finish iterations for z_w + ,eps_conv = 0.01 & !< criteria to finish iterations for d_conv + ,eps_sfs = 0.01 & !< criteria to finish iterations for d_sfs + ,z_w_max = 20.0 & !< max warm layer thickness + ,z_w_min = 0.2 & !< min warm layer thickness + ,z_w_ini = 0.2 & !< initial warm layer thickness in dtl_onset + ,z_c_max = 0.01 & !< maximum of sub-layer thickness (m) + ,z_c_ini = 0.001 & !< initial value of z_c + ,ustar_a_min = 0.031 & !< minimum of friction wind speed (m/s): 0.031 ~ 1m/s at 10 m hight + ,tau_min = 0.005 & !< minimum of wind stress for dtm + ,exp_const = 9.5 & !< coefficient in exponet profile + ,delz = 0.1 & !< vertical increment for integral calculation (m) + ,von = 0.4 & !< von karman's "constant" + ,t0k = 273.16 & !< celsius to kelvin + ,gray = 0.97 & + ,sst_max = 308.16 & + ,tw_max = 5.0 & + ,wd_max = 2.0 & + ,omg_m = 1.0 & !< trace factor to apply salinity effect + ,omg_rot = 1.0 & !< trace factor to apply rotation effect + ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect + ,visw = 1.e-6 & !< m2/s kinematic viscosity water + ,novalue = 0 & + ,smallnumber = 1.e-6 & + ,timestep_oc = sec_in_day/8. & !< time step in the ocean model (3 hours) + ,radian = 2.*pi/180. & + ,rad2deg = 180./pi & + ,cp_w = 4000. & !< specific heat water (j/kg/k ) + ,rho0_w = 1022.0 & !< density water (kg/m3 ) (or 1024.438) + ,vis_w = 1.e-6 & !< kinematic viscosity water (m2/s ) + ,tc_w = 0.6 & !< thermal conductivity water (w/m/k ) + ,capa_w = 3950.0 & !< heat capacity of sea water ! + ,thref = 1.0e-3 !< reference value of specific volume (m**3/kg) !!$!============================================ !!$ diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 2b36be5df..858659e90 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -1,3 +1,4 @@ + !>\file module_nst_water_prop.f90 !! This file contains GFS NSST water property subroutines. @@ -5,46 +6,45 @@ !!This module contains GFS NSST water property subroutines. !!\ingroup gfs_nst_main_mod module module_nst_water_prop - use machine, only : kind_phys - use module_nst_parameters, only : t0k + use machine , only : kind_phys + use module_nst_parameters , only : t0k, zero, one, half + + implicit none ! private - public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & - sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d + public :: rhocoef, density, sw_rad_skin, grv, sw_ps_9b, sw_ps_9b_aw, get_dtzm_point, get_dtzm_2d - integer, parameter :: kp = kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp, half=0.5_kp ! interface sw_ps_9b module procedure sw_ps_9b - end interface + end interface sw_ps_9b interface sw_ps_9b_aw module procedure sw_ps_9b_aw - end interface + end interface sw_ps_9b_aw ! interface sw_rad module procedure sw_fairall_6exp_v1 ! sw_wick_v1 - end interface + end interface sw_rad interface sw_rad_aw module procedure sw_fairall_6exp_v1_aw - end interface + end interface sw_rad_aw interface sw_rad_sum module procedure sw_fairall_6exp_v1_sum - end interface + end interface sw_rad_sum interface sw_rad_upper module procedure sw_soloviev_3exp_v2 - end interface + end interface sw_rad_upper interface sw_rad_upper_aw module procedure sw_soloviev_3exp_v2_aw - end interface + end interface sw_rad_upper_aw interface sw_rad_skin module procedure sw_ohlmann_v1 - end interface + end interface sw_rad_skin contains ! ------------------------------------------------------ -!>\ingroup gfs_nst_main_mod -!! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). + !>\ingroup gfs_nst_main_mod + !! This subroutine computes thermal expansion coefficient (alpha) + !! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -55,7 +55,6 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) ! dynamical oceanography, pp310. ! note: compression effects are not included - implicit none real(kind=kind_phys), intent(in) :: t, s, rhoref real(kind=kind_phys), intent(out) :: alpha, beta real(kind=kind_phys) :: tc @@ -87,11 +86,10 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) end subroutine rhocoef ! ---------------------------------------- -!>\ingroup gfs_nst_main_mod -!! This subroutine computes sea water density. + !>\ingroup gfs_nst_main_mod + !! This subroutine computes sea water density. subroutine density(t, s, rho) ! ---------------------------------------- - implicit none ! input real(kind=kind_phys), intent(in) :: t !unit, k @@ -125,9 +123,9 @@ end subroutine density ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed -!! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . + !>\ingroup gfs_nst_main_mod + !! This subroutine computes the fraction of the solar radiation absorbed + !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z @@ -139,17 +137,15 @@ elemental subroutine sw_ps_9b(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none real(kind=kind_phys), intent(in) :: z real(kind=kind_phys), intent(out) :: fxp - real(kind=kind_phys), dimension(9), parameter :: & - f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>zero) then - fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & - f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & - f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) + fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & + f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & + f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) else fxp=zero endif @@ -161,8 +157,8 @@ end subroutine sw_ps_9b ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine + !>\ingroup gfs_nst_main_mod + !! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -173,17 +169,15 @@ elemental subroutine sw_ps_9b_aw(z,aw) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none real(kind=kind_phys), intent(in) :: z real(kind=kind_phys), intent(out) :: aw - real(kind=kind_phys), dimension(9), parameter :: & - f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>zero) then - aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & - (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & - (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) + aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & + (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & + (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) else aw=zero endif @@ -191,10 +185,10 @@ elemental subroutine sw_ps_9b_aw(z,aw) end subroutine sw_ps_9b_aw ! !====================== -!>\ingroup gfs_nst_main_mod -!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the depth -!! z (Fairall et al. (1996) \cite fairall_et_al_1996, p. 1298) following Paulson and Simpson -!! (1981) \cite paulson_and_simpson_1981 . + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the depth + !! z (Fairall et al. (1996) \cite fairall_et_al_1996, p. 1298) following Paulson and Simpson + !! (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_fairall_6exp_v1(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -206,13 +200,13 @@ elemental subroutine sw_fairall_6exp_v1(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: fxp - real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_c + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_c ! if(z>zero) then zgamma=z/gamma @@ -227,10 +221,10 @@ end subroutine sw_fairall_6exp_v1 !====================== ! ! -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates fraction of the solar radiation absorbed by the -!! ocean at the depth z (fairall et al.(1996) \cite fairall_et_al_1996; p.1298) -!! following Paulson and Simpson (1981) \cite paulson_and_simpson_1981. + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates fraction of the solar radiation absorbed by the + !! ocean at the depth z (fairall et al.(1996) \cite fairall_et_al_1996; p.1298) + !! following Paulson and Simpson (1981) \cite paulson_and_simpson_1981. elemental subroutine sw_fairall_6exp_v1_aw(z,aw) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -244,34 +238,31 @@ elemental subroutine sw_fairall_6exp_v1_aw(z,aw) ! ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: aw - real(kind=kind_phys) :: fxp - real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_aw + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_aw ! if(z>zero) then zgamma=z/gamma f_aw=(f/z)*((gamma/z)*(one-exp(-zgamma))-exp(-zgamma)) aw=sum(f_aw) - -! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw - + ! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw else aw=zero endif ! end subroutine sw_fairall_6exp_v1_aw ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the -!! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and -!! Simpson (1981) \cite paulson_and_simpson_1981 . -!>\param[in] z depth (m) -!>\param[out] sum for convection depth calculation + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the + !! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and + !! Simpson (1981) \cite paulson_and_simpson_1981 . + !>\param[in] z depth (m) + !>\param[out] sum for convection depth calculation elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -284,30 +275,30 @@ elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! sum: for convection depth calculation ! ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: sum + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: sum + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_sum + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_sum ! -! zgamma=z/gamma -! f_sum=(zgamma/z)*exp(-zgamma) -! sum=sum(f_sum) + ! zgamma=z/gamma + ! f_sum=(zgamma/z)*exp(-zgamma) + ! sum=sum(f_sum) - sum=(one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & - (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & - (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) + sum=( one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & + (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & + (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) ! end subroutine sw_fairall_6exp_v1_sum ! !====================== -!>\ingroup gfs_nst_main_mod -!! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) -!! \cite fairall_et_al_1996, p.1298) -!!\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!!\param[in] z depth (m) -!!\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) + !! \cite fairall_et_al_1996, p.1298) + !!\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !!\param[in] z depth (m) + !!\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -319,9 +310,8 @@ elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(one-exp(-z/8.e-4))) @@ -333,12 +323,12 @@ end subroutine sw_fairall_simple_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) -!! \cite zeng_and_beljaars_2005 , p.5). -!>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!>\param[in] z depth (m) -!>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) + !! \cite zeng_and_beljaars_2005 , p.5). + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (zeng and beljaars, 2005, p.5) @@ -350,9 +340,8 @@ elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(one-exp(-z/8.e-4))) @@ -364,13 +353,13 @@ end subroutine sw_wick_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes solar radiation absorbed by the ocean at the depth z -!! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following -!! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. -!>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!>\param[in] z depth (m) -!>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! This subroutine computes solar radiation absorbed by the ocean at the depth z + !! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following + !! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) @@ -383,12 +372,11 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z - real(kind=kind_phys),dimension(3) :: f_c - real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) & - ,gamma=(/12.8,0.357,0.014/) + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + real(kind=kind_phys), dimension(3) :: f_c + real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) + real(kind=kind_phys), dimension(3), parameter :: gamma=(/12.82,0.357,0.014/) ! if(z>zero) then f_c = f*gamma(int(one-exp(-z/gamma))) @@ -401,7 +389,7 @@ end subroutine sw_soloviev_3exp_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) @@ -414,9 +402,8 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(one & @@ -430,7 +417,7 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! end subroutine sw_soloviev_3exp_v2 -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) ! ! aw = d(fxp)/d(z) @@ -442,10 +429,9 @@ elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) ! output: ! aw: d(fxp)/d(z) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: aw - real(kind=kind_phys):: fxp + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys) :: fxp ! if(z>zero) then fxp=(one & @@ -462,7 +448,7 @@ end subroutine sw_soloviev_3exp_v2_aw ! !====================== ! -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_ohlmann_v1(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z @@ -473,9 +459,8 @@ elemental subroutine sw_ohlmann_v1(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: fxp + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp ! if(z>zero) then fxp=.065+11.*z-6.6e-5/z*(one-exp(-z/8.0e-4)) @@ -486,276 +471,264 @@ elemental subroutine sw_ohlmann_v1(z,fxp) end subroutine sw_ohlmann_v1 ! -!>\ingroup gfs_nst_main_mod -function grv(x) - real(kind=kind_phys) :: x !< sin(lat) - real(kind=kind_phys) :: gamma,c1,c2,c3,c4 - gamma=9.7803267715 - c1=0.0052790414 - c2=0.0000232718 - c3=0.0000001262 - c4=0.0000000007 - - grv=gamma*(1.0+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) -end function grv - -!>\ingroup gfs_nst_main_mod -!>This subroutine computes solar time from the julian date. -subroutine solar_time_from_julian(jday,xlon,soltim) - ! - ! calculate solar time from the julian date + !>\ingroup gfs_nst_main_mod + real(kind_phys) function grv(x) + real(kind=kind_phys) :: x !< sin(lat) + real(kind=kind_phys) :: gamma,c1,c2,c3,c4 + gamma=9.7803267715 + c1=0.0052790414 + c2=0.0000232718 + c3=0.0000001262 + c4=0.0000000007 + + grv=gamma*(one+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) + end function grv + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes solar time from the julian date. + subroutine solar_time_from_julian(jday,xlon,soltim) + ! + ! calculate solar time from the julian date + ! + real(kind=kind_phys), intent(in) :: jday + real(kind=kind_phys), intent(in) :: xlon + real(kind=kind_phys), intent(out) :: soltim + real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime + ! + fjd=jday-floor(jday) + fjd=jday + xhr=floor(fjd*24.0)-sign(12.0,fjd-half) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 + xsec=zero + intime=xhr+xmin/60.0+xsec/3600.0+24.0 + soltim=mod(xlon/15.0+intime,24.0)*3600.0 + end subroutine solar_time_from_julian + ! - implicit none - real(kind=kind_phys), intent(in) :: jday - real(kind=kind_phys), intent(in) :: xlon - real(kind=kind_phys), intent(out) :: soltim - real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime - integer :: nn + !*********************************************************************** ! - fjd=jday-floor(jday) - fjd=jday - xhr=floor(fjd*24.0)-sign(12.0,fjd-half) - xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 - xsec=zero - intime=xhr+xmin/60.0+xsec/3600.0+24.0 - soltim=mod(xlon/15.0+intime,24.0)*3600.0 -end subroutine solar_time_from_julian - -! -!*********************************************************************** -! -!>\ingroup gfs_nst_main_mod -!> This subroutine computes julian day and fraction from year, -!! month, day and time UTC. - subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) -!fpp$ noconcur r -!$$$ subprogram documentation block -! . . . . -! subprogram: compjd computes julian day and fraction -! prgmmr: kenneth campana org: w/nmc23 date: 89-07-07 -! -! abstract: computes julian day and fraction -! from year, month, day and time utc. -! -! program history log: -! 77-05-06 ray orzol,gfdl -! 98-05-15 iredell y2k compliance -! -! usage: call compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) -! input argument list: -! jyr - year (4 digits) -! jmnth - month -! jday - day -! jhr - hour -! jmn - minutes -! output argument list: -! jd - julian day. -! fjd - fraction of the julian day. -! -! subprograms called: -! iw3jdn compute julian day number -! -! attributes: -! language: fortran. -! -!$$$ - use machine , only :kind_phys - implicit none -! - integer jyr,jmnth,jday,jhr,jmn,jd - integer iw3jdn - real (kind=kind_phys) fjd - jd=iw3jdn(jyr,jmnth,jday) - if(jhr.lt.12) then - jd=jd-1 - fjd=half+jhr/24.+jmn/1440. - else - fjd=(jhr-12)/24.+jmn/1440. - endif - end subroutine compjd - -!>\ingroup gfs_nst_main_mod -!>This subroutine computes dtm (the mean of \f$dT(z)\f$). - subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) -! ===================================================================== ! -! ! -! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! -! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! -! ! -! usage: ! -! ! -! call get_dtm12 ! -! ! -! inputs: ! -! (xt,xz,dt_cool,zc,z1,z2, ! -! outputs: ! -! dtm) ! -! ! -! program history log: ! -! ! -! 2015 -- xu li createad original code ! -! inputs: ! -! xt - real, heat content in dtl 1 ! -! xz - real, dtl thickness 1 ! -! dt_cool - real, sub-layer cooling amount 1 ! -! zc - sub-layer cooling thickness 1 ! -! z1 - lower bound of depth of sea temperature 1 ! -! z2 - upper bound of depth of sea temperature 1 ! -! outputs: ! -! dtm - mean of dT(z) (z1 to z2) 1 ! -! - use machine , only : kind_phys - - implicit none - - real (kind=kind_phys), intent(in) :: xt,xz,dt_cool,zc,z1,z2 - real (kind=kind_phys), intent(out) :: dtm -! Local variables - real (kind=kind_phys) :: dt_warm,dtw,dtc - -! -! get the mean warming in the range of z=z1 to z=z2 -! - dtw = zero - if ( xt > zero ) then - dt_warm = (xt+xt)/xz ! Tw(0) - if ( z1 < z2) then - if ( z2 < xz ) then - dtw = dt_warm*(one-(z1+z2)/(xz+xz)) - elseif ( z1 < xz .and. z2 >= xz ) then - dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < xz ) then - dtw = dt_warm*(one-z1/xz) - endif + !>\ingroup gfs_nst_main_mod + !> This subroutine computes julian day and fraction from year, + !! month, day and time UTC. + subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + !fpp$ noconcur r + !$$$ subprogram documentation block + ! . . . . + ! subprogram: compjd computes julian day and fraction + ! prgmmr: kenneth campana org: w/nmc23 date: 89-07-07 + ! + ! abstract: computes julian day and fraction + ! from year, month, day and time utc. + ! + ! program history log: + ! 77-05-06 ray orzol,gfdl + ! 98-05-15 iredell y2k compliance + ! + ! usage: call compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + ! input argument list: + ! jyr - year (4 digits) + ! jmnth - month + ! jday - day + ! jhr - hour + ! jmn - minutes + ! output argument list: + ! jd - julian day. + ! fjd - fraction of the julian day. + ! + ! subprograms called: + ! iw3jdn compute julian day number + ! + ! attributes: + ! language: fortran. + ! + !$$$ + ! + integer :: jyr,jmnth,jday,jhr,jmn,jd + integer :: iw3jdn + real (kind=kind_phys) fjd + jd=iw3jdn(jyr,jmnth,jday) + if(jhr.lt.12) then + jd=jd-1 + fjd=half+jhr/24.+jmn/1440. + else + fjd=(jhr-12)/24.+jmn/1440. endif - endif -! -! get the mean cooling in the range of z=z1 to z=z2 -! - dtc = zero - if ( zc > zero ) then - if ( z1 < z2) then - if ( z2 < zc ) then - dtc = dt_cool*(one-(z1+z2)/(zc+zc)) - elseif ( z1 < zc .and. z2 >= zc ) then - dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < zc ) then - dtc = dt_cool*(one-z1/zc) - endif + end subroutine compjd + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes dtm (the mean of \f$dT(z)\f$). + subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) + ! ===================================================================== ! + ! ! + ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtm12 ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + real (kind=kind_phys), intent(in) :: xt,xz,dt_cool,zc,z1,z2 + real (kind=kind_phys), intent(out) :: dtm + ! Local variables + real (kind=kind_phys) :: dt_warm,dtw,dtc + + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt > zero ) then + dt_warm = (xt+xt)/xz ! Tw(0) + if ( z1 < z2) then + if ( z2 < xz ) then + dtw = dt_warm*(one-(z1+z2)/(xz+xz)) + elseif ( z1 < xz .and. z2 >= xz ) then + dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < xz ) then + dtw = dt_warm*(one-z1/xz) + endif + endif endif - endif - -! -! get the mean T departure from Tf in the range of z=z1 to z=z2 -! - dtm = dtw - dtc - - end subroutine get_dtzm_point - -!>\ingroup gfs_nst_main_mod - subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) -!subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) -! ===================================================================== ! -! ! -! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! -! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! -! ! -! usage: ! -! ! -! call get_dtzm_2d ! -! ! -! inputs: ! -! (xt,xz,dt_cool,zc,z1,z2, ! -! outputs: ! -! dtm) ! -! ! -! program history log: ! -! ! -! 2015 -- xu li createad original code ! -! inputs: ! -! xt - real, heat content in dtl 1 ! -! xz - real, dtl thickness 1 ! -! dt_cool - real, sub-layer cooling amount 1 ! -! zc - sub-layer cooling thickness 1 ! -! wet - logical, flag for wet point (ocean or lake) 1 ! -! icy - logical, flag for ice point (ocean or lake) 1 ! -! nx - integer, dimension in x-direction (zonal) 1 ! -! ny - integer, dimension in y-direction (meridional) 1 ! -! z1 - lower bound of depth of sea temperature 1 ! -! z2 - upper bound of depth of sea temperature 1 ! -! nth - integer, num of openmp thread 1 ! -! outputs: ! -! dtm - mean of dT(z) (z1 to z2) 1 ! -! - use machine , only : kind_phys - - implicit none - - integer, intent(in) :: nx,ny, nth - real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc - logical, dimension(nx,ny), intent(in) :: wet -! logical, dimension(nx,ny), intent(in) :: wet,icy - real (kind=kind_phys), intent(in) :: z1,z2 - real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm -! Local variables - integer :: i,j - real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi - - -!$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) - do j = 1, ny - do i= 1, nx - - dtm(i,j) = zero ! initialize dtm - - if ( wet(i,j) ) then -! -! get the mean warming in the range of z=z1 to z=z2 -! - dtw = zero - if ( xt(i,j) > zero ) then - xzi = one / xz(i,j) - dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) - if (z1 < z2) then - if ( z2 < xz(i,j) ) then - dtw = dt_warm * (one-half*(z1+z2)*xzi) - elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then - dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) - endif - elseif (z1 == z2 ) then - if (z1 < xz(i,j) ) then - dtw = dt_warm * (one-z1*xzi) - endif + ! + ! get the mean cooling in the range of z=z1 to z=z2 + ! + dtc = zero + if ( zc > zero ) then + if ( z1 < z2) then + if ( z2 < zc ) then + dtc = dt_cool*(one-(z1+z2)/(zc+zc)) + elseif ( z1 < zc .and. z2 >= zc ) then + dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) endif - endif -! -! get the mean cooling in the range of z=0 to z=zsea -! - dtc = zero - if ( zc(i,j) > zero ) then - if ( z1 < z2) then - if ( z2 < zc(i,j) ) then - dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) - elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then - dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < zc(i,j) ) then - dtc = dt_cool(i,j) * (one-z1/zc(i,j)) - endif + elseif ( z1 == z2 ) then + if ( z1 < zc ) then + dtc = dt_cool*(one-z1/zc) endif - endif -! get the mean T departure from Tf in the range of z=z1 to z=z2 - dtm(i,j) = dtw - dtc - endif ! if ( wet(i,j)) then + endif + endif + + ! + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + ! + dtm = dtw - dtc + + end subroutine get_dtzm_point + + !>\ingroup gfs_nst_main_mod + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) + !subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) + ! ===================================================================== ! + ! ! + ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtzm_2d ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! wet - logical, flag for wet point (ocean or lake) 1 ! + ! icy - logical, flag for ice point (ocean or lake) 1 ! + ! nx - integer, dimension in x-direction (zonal) 1 ! + ! ny - integer, dimension in y-direction (meridional) 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! nth - integer, num of openmp thread 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + integer, intent(in) :: nx,ny, nth + real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc + logical, dimension(nx,ny), intent(in) :: wet + ! logical, dimension(nx,ny), intent(in) :: wet,icy + real (kind=kind_phys), intent(in) :: z1,z2 + real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm + ! Local variables + integer :: i,j + real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi + + + !$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) + do j = 1, ny + do i= 1, nx + + dtm(i,j) = zero ! initialize dtm + + if ( wet(i,j) ) then + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt(i,j) > zero ) then + xzi = one / xz(i,j) + dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) + if (z1 < z2) then + if ( z2 < xz(i,j) ) then + dtw = dt_warm * (one-half*(z1+z2)*xzi) + elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then + dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) + endif + elseif (z1 == z2 ) then + if (z1 < xz(i,j) ) then + dtw = dt_warm * (one-z1*xzi) + endif + endif + endif + ! + ! get the mean cooling in the range of z=0 to z=zsea + ! + dtc = zero + if ( zc(i,j) > zero ) then + if ( z1 < z2) then + if ( z2 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) + elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then + dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-z1/zc(i,j)) + endif + endif + endif + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + dtm(i,j) = dtw - dtc + endif ! if ( wet(i,j)) then + enddo enddo - enddo -! + ! - end subroutine get_dtzm_2d + end subroutine get_dtzm_2d end module module_nst_water_prop diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f deleted file mode 100644 index 2ca70666d..000000000 --- a/physics/sfc_nst.f +++ /dev/null @@ -1,696 +0,0 @@ -!>\file sfc_nst.f -!! This file contains the GFS NSST model. - -!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. - module sfc_nst - - contains - -!>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module -!! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. -!> @{ -!! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. -!! \section arg_table_sfc_nst_run Argument Table -!! \htmlinclude sfc_nst_run.html -!! -!> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm - subroutine sfc_nst_run & - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: - & pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - & lseaspray, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & - & sinlat, stress, & - & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & - & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, thsfc_loc, & - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: - & ) -! -! ===================================================================== ! -! description: ! -! ! -! ! -! usage: ! -! ! -! call sfc_nst ! -! inputs: ! -! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! -! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! -! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, thsfc_loc, ! -! input/outputs: ! -! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! -! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! -! -- outputs: -! qsurf, gflux, cmm, chh, evap, hflx, ep ! -! ) -! ! -! ! -! subprogram/functions called: w3movdat, iw3jdn, fpvs, density, ! -! rhocoef, cool_skin, warm_layer, jacobi_temp. ! -! ! -! program history log: ! -! 2007 -- xu li createad original code ! -! 2008 -- s. moorthi adapted to the parallel version ! -! may 2009 -- y.-t. hou modified to include input lw surface ! -! emissivity from radiation. also replaced the ! -! often comfusing combined sw and lw suface ! -! flux with separate sfc net sw flux (defined ! -! as dn-up) and lw flux. added a program doc block. ! -! sep 2009 -- s. moorthi removed rcl and additional reformatting ! -! and optimization + made pa as input pressure unit.! -! 2009 -- xu li recreatead the code ! -! feb 2010 -- s. moorthi added some changes made to the previous ! -! version ! -! Jul 2016 -- X. Li, modify the diurnal warming event reset ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! inputs: size ! -! im - integer, horiz dimension 1 ! -! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind (m/s) im ! -! t1 - real, surface layer mean temperature ( k ) im ! -! q1 - real, surface layer mean specific humidity im ! -! tref - real, reference/foundation temperature ( k ) im ! -! cm - real, surface exchange coeff for momentum (m/s) im ! -! ch - real, surface exchange coeff heat & moisture(m/s) im ! -! lseaspray- logical, .t. for parameterization for sea spray 1 ! -! fm - real, a stability profile function for momentum im ! -! fm10 - real, a stability profile function for momentum im ! -! at 10m ! -! prsl1 - real, surface layer mean pressure (pa) im ! -! prslki - real, im ! -! prsik1 - real, im ! -! prslk1 - real, im ! -! wet - logical, =T if any ocn/lake water (F otherwise) im ! -! use_lake_model- logical, =T if flake model is used for lake im ! -! icy - logical, =T if any ice im ! -! xlon - real, longitude (radians) im ! -! sinlat - real, sin of latitude im ! -! stress - real, wind stress (n/m**2) im ! -! sfcemis - real, sfc lw emissivity (fraction) im ! -! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! -! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! -! rain - real, rainfall rate (kg/m**2/s) im ! -! timestep - real, timestep interval (second) 1 ! -! kdt - integer, time step counter 1 ! -! solhr - real, fcst hour at the end of prev time step 1 ! -! xcosz - real, consine of solar zenith angle 1 ! -! wind - real, wind speed (m/s) im ! -! flag_iter- logical, execution or not im ! -! when iter = 1, flag_iter = .true. for all grids im ! -! when iter = 2, flag_iter = .true. when wind < 2 im ! -! for both land and ocean (when nstf_name1 > 0) im ! -! flag_guess-logical, .true.= guess step to get CD et al im ! -! when iter = 1, flag_guess = .true. when wind < 2 im ! -! when iter = 2, flag_guess = .false. for all grids im ! -! nstf_name - integers , NSST related flag parameters 1 ! -! nstf_name1 : 0 = NSSTM off 1 ! -! 1 = NSSTM on but uncoupled 1 ! -! 2 = NSSTM on and coupled 1 ! -! nstf_name4 : zsea1 in mm 1 ! -! nstf_name5 : zsea2 in mm 1 ! -! lprnt - logical, control flag for check print out 1 ! -! ipr - integer, grid index for check print out 1 ! -! thsfc_loc- logical, flag for reference pressure in theta 1 ! -! ! -! input/outputs: -! li added for oceanic components -! tskin - real, ocean surface skin temperature ( k ) im ! -! tsurf - real, the same as tskin ( k ) but for guess run im ! -! xt - real, heat content in dtl im ! -! xs - real, salinity content in dtl im ! -! xu - real, u-current content in dtl im ! -! xv - real, v-current content in dtl im ! -! xz - real, dtl thickness im ! -! zm - real, mxl thickness im ! -! xtts - real, d(xt)/d(ts) im ! -! xzts - real, d(xz)/d(ts) im ! -! dt_cool - real, sub-layer cooling amount im ! -! d_conv - real, thickness of free convection layer (fcl) im ! -! z_c - sub-layer cooling thickness im ! -! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! -! c_d - coefficient2 to calculate d(tz)/d(ts) im ! -! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! -! w_d - coefficient4 to calculate d(tz)/d(ts) im ! -! ifd - real, index to start dtlm run or not im ! -! qrain - real, sensible heat flux due to rainfall (watts) im ! - -! outputs: ! - -! qsurf - real, surface air saturation specific humidity im ! -! gflux - real, soil heat flux (w/m**2) im ! -! cmm - real, im ! -! chh - real, im ! -! evap - real, evaperation from latent heat flux im ! -! hflx - real, sensible heat flux im ! -! ep - real, potential evaporation im ! -! ! -! ===================================================================== ! - use machine , only : kind_phys - use funcphys, only : fpvs - use date_def, only : idate - use module_nst_water_prop, only: get_dtzm_point - use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & - & sigma_r,solar_time_6am,ri_c,z_w_max,delz,wd_max, & - & rad2deg,const_rot,tau_min,tw_max,sst_max - use module_nst_water_prop, only: solar_time_from_julian, & - & density,rhocoef,compjd,grv & - &, sw_ps_9b - use nst_module, only : cool_skin,dtm_1p,cal_w,cal_ttop, & - & convdepth,dtm_1p_fca,dtm_1p_tla, & - & dtm_1p_mwa,dtm_1p_mda,dtm_1p_mta, & - & dtl_reset -! - implicit none - - integer, parameter :: kp = kind_phys -! -! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0_kp ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0_kp ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001_kp ! cos(89.994) - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - -! --- inputs: - integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & - & nstf_name5 - real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & - & epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice - real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tref, cm, ch, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, xlon, xcosz, & - & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind - real (kind=kind_phys), intent(in) :: timestep - real (kind=kind_phys), intent(in) :: solhr - -! For sea spray effect - logical, intent(in) :: lseaspray -! - logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet - integer, dimension(:), intent(in) :: use_lake_model -! &, icy - logical, intent(in) :: lprnt - logical, intent(in) :: thsfc_loc - -! --- input/outputs: -! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation - real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & - & tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & qsurf, gflux, cmm, chh, evap, hflx, ep - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals -! - integer :: k,i -! - real (kind=kind_phys), dimension(im) :: q0, qss, rch, - & rho_a, theta1, tv1, wndmag - - real(kind=kind_phys) elocp,tem,cpinv,hvapi -! -! nstm related prognostic fields -! - logical flag(im) - real (kind=kind_phys), dimension(im) :: - & xt_old, xs_old, xu_old, xv_old, xz_old,zm_old,xtts_old, - & xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old - - real(kind=kind_phys) ulwflx(im), nswsfc(im) -! real(kind=kind_phys) rig(im), -! & ulwflx(im),dlwflx(im), -! & slrad(im),nswsfc(im) - real(kind=kind_phys) alpha,beta,rho_w,f_nsol,sss,sep, - & cosa,sina,taux,tauy,grav,dz,t0,ttop0,ttop - - real(kind=kind_phys) le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich - real(kind=kind_phys) rnl_ts,hs_ts,hl_ts,rf_ts,q_ts - real(kind=kind_phys) fw,q_warm - real(kind=kind_phys) t12,alon,tsea,sstc,dta,dtz - real(kind=kind_phys) zsea1,zsea2,soltim - logical do_nst - -! external functions called: iw3jdn - integer :: iw3jdn -! -! parameters for sea spray effect -! - real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, - & bb1, hflxs, evaps, ptem -! -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, -! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, - real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, - & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 -! -!====================================================================================================== -cc - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nstf_name1 == 0) return ! No NSST model used - - cpinv = one/cp - hvapi = one/hvap - elocp = hvap/cp - - sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready -! -! flag for open water and where the iteration is on -! - do_nst = .false. - do i = 1, im -! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 - do_nst = do_nst .or. flag(i) - enddo - if (.not. do_nst) return -! -! save nst-related prognostic fields for guess run -! - do i=1, im -! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then - xt_old(i) = xt(i) - xs_old(i) = xs(i) - xu_old(i) = xu(i) - xv_old(i) = xv(i) - xz_old(i) = xz(i) - zm_old(i) = zm(i) - xtts_old(i) = xtts(i) - xzts_old(i) = xzts(i) - ifd_old(i) = ifd(i) - tskin_old(i) = tskin(i) - dt_cool_old(i) = dt_cool(i) - z_c_old(i) = z_c(i) - endif - enddo - - -! --- ... initialize variables. all units are m.k.s. unless specified. -! ps is in pascals, wind is wind speed, theta1 is surface air -! estimated from level 1 temperature, rho_a is air density and -! qss is saturation specific humidity at the water surface -!! - do i = 1, im - if ( flag(i) ) then - - nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) - wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - - q0(i) = max(q1(i), 1.0e-8_kp) - - if(thsfc_loc) then ! Use local potential temperature - theta1(i) = t1(i) * prslki(i) - else ! Use potential temperature referenced to 1000 hPa - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer - endif - - tv1(i) = t1(i) * (one + rvrdm1*q0(i)) - rho_a(i) = prsl1(i) / (rd*tv1(i)) - qss(i) = fpvs(tsurf(i)) ! pa - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa -! - evap(i) = zero - hflx(i) = zero - gflux(i) = zero - ep(i) = zero - -! --- ... rcp = rho cp ch v - - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) - -!> - Calculate latent and sensible heat flux over open water with tskin. -! at previous time step - evap(i) = elocp * rch(i) * (qss(i) - q0(i)) - qsurf(i) = qss(i) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) - endif - -! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', -! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) -! &,' tsurf=',tsurf(i) - endif - enddo - -! run nst model: dtm + slm -! - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - -!> - Call module_nst_water_prop::density() to compute sea water density. -!> - Call module_nst_water_prop::rhocoef() to compute thermal expansion -!! coefficient (\a alpha) and saline contraction coefficient (\a beta). - do i = 1, im - if ( flag(i) ) then - tsea = tsurf(i) - t12 = tsea*tsea - ulwflx(i) = sfcemis(i) * sbc * t12 * t12 - alon = xlon(i)*rad2deg - grav = grv(sinlat(i)) - soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp - call density(tsea,sss,rho_w) ! sea water density - call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta -! -!> - Calculate sensible heat flux (\a qrain) due to rainfall. -! - le = (2.501_kp-0.00237_kp*tsea)*1e6_kp - dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity - dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) - & * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) - alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w - qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) - -!> - Calculate input non solar heat flux as upward = positive to models here - - f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) - & + omg_sh*qrain(i) - -! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', -! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) -! &,' omg_sh=',omg_sh,' qrain=',qrain(i) - - sep = sss*(evap(i)/le-rain(i))/rho_w - ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity -! -! sensitivities of heat flux components to ts -! - rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) - hs_ts = rch(i) - hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) - rf_ts = tem * (one+rch(i)*hl_ts) - q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts -! -!> - Call cool_skin(), which is the sub-layer cooling parameterization -!! (Fairfall et al. (1996) \cite fairall_et_al_1996). -! & calculate c_0, c_d -! - call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta - &, rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le - &, dt_cool(i),z_c(i),c_0(i),c_d(i)) - - tem = one / wndmag(i) - cosa = u1(i)*tem - sina = v1(i)*tem - taux = max(stress(i),tau_min)*cosa - tauy = max(stress(i),tau_min)*sina - fc = const_rot*sinlat(i) -! -! Run DTM-1p system. -! - if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then - else - ifd(i) = one -! -! calculate fcl thickness with current forcing and previous time's profile -! -! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) - -!> - Call convdepth() to calculate depth for convective adjustments. - if ( f_nsol > zero .and. xt(i) > zero ) then - call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w - &, alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) - else - d_conv(i) = zero - endif - -! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) -! -! determine rich: wind speed dependent (right now) -! -! if ( wind(i) < 1.0 ) then -! rich = 0.25 + 0.03*wind(i) -! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then -! rich = 0.25 + 0.1*wind(i) -! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then -! rich = 0.25 + 0.6*wind(i) -! elseif ( wind(i) >= 6.0 ) then -! rich = 0.25 + min(0.8*wind(i),0.50) -! endif - - rich = ri_c - -!> - Call the diurnal thermocline layer model dtm_1p(). - call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), - & f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, - & sinlat(i),soltim,grav,le,d_conv(i), - & xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) - -! apply mda - if ( xt(i) > zero ) then -!> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply -!! minimum depth adjustment (mda). - call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then -!> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. - call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), - & xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' -! &,z_w_max - endif - -! apply fca - if ( d_conv(i) > zero ) then -!> - If thickness of free convection layer > 0.0, call dtm_1p_fca() -!! to apply free convection adjustment. -!> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). - call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) - -! apply tla - dz = min(xz(i),max(d_conv(i),delz)) -! -!> - Call sw_ps_9b() to compute the fraction of the solar radiation -!! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). -!! And calculate the total heat absorbed in warm layer. - call sw_ps_9b(delz,fw) - q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer - -!> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with -!! thickness of \a dz. - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho_w,dz, - & xt(i),xz(i),ttop0) - -! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', -! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), -! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), -! &' xz=',xz(i),' qrain=',qrain(i) - - ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) - -! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) -! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz -! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 - -!> - Call dtm_1p_tla() to apply top layer adjustment. - if ( ttop > ttop0 ) then - call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', -! &z_w_max - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - endif ! if ( q_warm > 0.0 ) then - -! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) - -! apply mwa -!> - Call dt_1p_mwa() to apply maximum warming adjustment. - t0 = (xt(i)+xt(i))/xz(i) - if ( t0 > tw_max ) then - call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) - -! apply mta -!> - Call dtm_1p_mta() to apply maximum temperature adjustment. - sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) - - if ( sstc > sst_max ) then - dta = sstc - sst_max - call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) -! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), -! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif -! - endif ! if ( xt(i) > 0.0 ) then -! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0_kp*timestep ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - - endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day - -! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) - -! update tsurf (when flag(i) .eqv. .true. ) -!> - Call get_dtzm_point() to computes \a dtz and \a tsurf. - call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), - & zsea1,zsea2,dtz) - tsurf(i) = max(tgice, tref(i) + dtz ) - -! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', -! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) - -!> - Call cal_w() to calculate \a w_0 and \a w_d. - if ( xt(i) > zero ) then - call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) - else - w_0(i) = zero - w_d(i) = zero - endif - -! if ( xt(i) > 0.0 ) then -! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) -! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) -! else -! rig(i) = 0.25 -! endif - -! qrain(i) = rig(i) - zm(i) = wind(i) - - endif - enddo - -! restore nst-related prognostic fields for guess run - do i=1, im -! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. use_lake_model(i)/=1) then - if (flag_guess(i)) then ! when it is guess of - xt(i) = xt_old(i) - xs(i) = xs_old(i) - xu(i) = xu_old(i) - xv(i) = xv_old(i) - xz(i) = xz_old(i) - zm(i) = zm_old(i) - xtts(i) = xtts_old(i) - xzts(i) = xzts_old(i) - ifd(i) = ifd_old(i) - tskin(i) = tskin_old(i) - dt_cool(i) = dt_cool_old(i) - z_c(i) = z_c_old(i) - else -! -! update tskin when coupled and not guess run -! (all other NSST variables have been updated in this case) -! - if ( nstf_name1 > 1 ) then - tskin(i) = tsurf(i) - endif ! if nstf_name1 > 1 then - endif ! if flag_guess(i) then - endif ! if wet(i) .and. .not.icy(i) then - enddo - -! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) - - if ( nstf_name1 > 1 ) then -!> - Calculate latent and sensible heat flux over open water with updated tskin -!! for the grids of open water and the iteration is on. - do i = 1, im - if ( flag(i) ) then - qss(i) = fpvs( tskin(i) ) - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) - qsurf(i) = qss(i) - evap(i) = elocp*rch(i) * (qss(i) - q0(i)) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tskin(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) - endif - - endif - enddo - endif ! if ( nstf_name1 > 1 ) then -! -!> - Include sea spray effects -! - do i=1,im - if(lseaspray .and. flag(i)) then - f10m = fm10(i) / fm(i) - u10m = f10m * u1(i) - v10m = f10m * v1(i) - ws10 = sqrt(u10m*u10m + v10m*v10m) - ws10 = max(ws10,1.) - ws10 = min(ws10,ws10cr) - tem = .015 * ws10 * ws10 - ru10 = 1. - .087 * log(10./tem) - qss1 = fpvs(t1(i)) - qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) - tem = rd * cp * t1(i) * t1(i) - tem = 1. + eps * hvap * hvap * qss1 / tem - bb1 = 1. / tem - evaps = conlf * (ws10**5.4) * ru10 * bb1 - evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) - evap(i) = evap(i) + alps * evaps - hflxs = consf * (ws10**3.4) * ru10 - hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) - ptem = alps - gams - hflx(i) = hflx(i) + bets * hflxs - ptem * evaps - endif - enddo -! - do i=1,im - if ( flag(i) ) then - tem = one / rho_a(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo -! -! if (lprnt) print *,' tskin=',tskin(ipr) - - return - end subroutine sfc_nst_run -!> @} - end module sfc_nst diff --git a/physics/sfc_nst.f90 b/physics/sfc_nst.f90 new file mode 100644 index 000000000..08b1b48e4 --- /dev/null +++ b/physics/sfc_nst.f90 @@ -0,0 +1,664 @@ +!>\file sfc_nst.f90 +!! This file contains the GFS NSST model. + +!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. +module sfc_nst + + use machine , only : kind_phys, kp => kind_phys + use funcphys , only : fpvs + use module_nst_parameters , only : one, zero, half + use module_nst_parameters , only : t0k, cp_w, omg_m, omg_sh, sigma_r, solar_time_6am, sst_max + use module_nst_parameters , only : ri_c, z_w_max, delz, wd_max, rad2deg, const_rot, tau_min, tw_max + use module_nst_water_prop , only : get_dtzm_point, density, rhocoef, grv, sw_ps_9b + use nst_module , only : cool_skin, dtm_1p, cal_w, cal_ttop, convdepth, dtm_1p_fca + use nst_module , only : dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, dtl_reset + ! + implicit none +contains + + !>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module + !! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. + !> @{ + !! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. + !! \section arg_table_sfc_nst_run Argument Table + !! \htmlinclude sfc_nst_run.html + !! + !> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm + subroutine sfc_nst_run & + ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: + pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & + lseaspray, fm, fm10, & + prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & + sinlat, stress, & + sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & + wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & + nstf_name5, lprnt, ipr, thsfc_loc, & + tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & + qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: + ) + ! + ! ===================================================================== ! + ! description: ! + ! ! + ! ! + ! usage: ! + ! ! + ! call sfc_nst ! + ! inputs: ! + ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! + ! lseaspray, fm, fm10, ! + ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! + ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! + ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! + ! nstf_name5, lprnt, ipr, thsfc_loc, ! + ! input/outputs: ! + ! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! + ! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! + ! -- outputs: + ! qsurf, gflux, cmm, chh, evap, hflx, ep ! + ! ) + ! ! + ! ! + ! subprogram/functions called: fpvs, density, rhocoef, cool_skin ! + ! ! + ! program history log: ! + ! 2007 -- xu li createad original code ! + ! 2008 -- s. moorthi adapted to the parallel version ! + ! may 2009 -- y.-t. hou modified to include input lw surface ! + ! emissivity from radiation. also replaced the ! + ! often comfusing combined sw and lw suface ! + ! flux with separate sfc net sw flux (defined ! + ! as dn-up) and lw flux. added a program doc block. ! + ! sep 2009 -- s. moorthi removed rcl and additional reformatting ! + ! and optimization + made pa as input pressure unit.! + ! 2009 -- xu li recreatead the code ! + ! feb 2010 -- s. moorthi added some changes made to the previous ! + ! version ! + ! Jul 2016 -- X. Li, modify the diurnal warming event reset ! + ! ! + ! ! + ! ==================== definition of variables ==================== ! + ! ! + ! inputs: size ! + ! im - integer, horiz dimension 1 ! + ! ps - real, surface pressure (pa) im ! + ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! + ! t1 - real, surface layer mean temperature ( k ) im ! + ! q1 - real, surface layer mean specific humidity im ! + ! tref - real, reference/foundation temperature ( k ) im ! + ! cm - real, surface exchange coeff for momentum (m/s) im ! + ! ch - real, surface exchange coeff heat & moisture(m/s) im ! + ! lseaspray- logical, .t. for parameterization for sea spray 1 ! + ! fm - real, a stability profile function for momentum im ! + ! fm10 - real, a stability profile function for momentum im ! + ! at 10m ! + ! prsl1 - real, surface layer mean pressure (pa) im ! + ! prslki - real, im ! + ! prsik1 - real, im ! + ! prslk1 - real, im ! + ! wet - logical, =T if any ocn/lake water (F otherwise) im ! + ! use_lake_model- logical, =T if flake model is used for lake im ! + ! icy - logical, =T if any ice im ! + ! xlon - real, longitude (radians) im ! + ! sinlat - real, sin of latitude im ! + ! stress - real, wind stress (n/m**2) im ! + ! sfcemis - real, sfc lw emissivity (fraction) im ! + ! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! + ! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! + ! rain - real, rainfall rate (kg/m**2/s) im ! + ! timestep - real, timestep interval (second) 1 ! + ! kdt - integer, time step counter 1 ! + ! solhr - real, fcst hour at the end of prev time step 1 ! + ! xcosz - real, consine of solar zenith angle 1 ! + ! wind - real, wind speed (m/s) im ! + ! flag_iter- logical, execution or not im ! + ! when iter = 1, flag_iter = .true. for all grids im ! + ! when iter = 2, flag_iter = .true. when wind < 2 im ! + ! for both land and ocean (when nstf_name1 > 0) im ! + ! flag_guess-logical, .true.= guess step to get CD et al im ! + ! when iter = 1, flag_guess = .true. when wind < 2 im ! + ! when iter = 2, flag_guess = .false. for all grids im ! + ! nstf_name - integers , NSST related flag parameters 1 ! + ! nstf_name1 : 0 = NSSTM off 1 ! + ! 1 = NSSTM on but uncoupled 1 ! + ! 2 = NSSTM on and coupled 1 ! + ! nstf_name4 : zsea1 in mm 1 ! + ! nstf_name5 : zsea2 in mm 1 ! + ! lprnt - logical, control flag for check print out 1 ! + ! ipr - integer, grid index for check print out 1 ! + ! thsfc_loc- logical, flag for reference pressure in theta 1 ! + ! ! + ! input/outputs: + ! li added for oceanic components + ! tskin - real, ocean surface skin temperature ( k ) im ! + ! tsurf - real, the same as tskin ( k ) but for guess run im ! + ! xt - real, heat content in dtl im ! + ! xs - real, salinity content in dtl im ! + ! xu - real, u-current content in dtl im ! + ! xv - real, v-current content in dtl im ! + ! xz - real, dtl thickness im ! + ! zm - real, mxl thickness im ! + ! xtts - real, d(xt)/d(ts) im ! + ! xzts - real, d(xz)/d(ts) im ! + ! dt_cool - real, sub-layer cooling amount im ! + ! d_conv - real, thickness of free convection layer (fcl) im ! + ! z_c - sub-layer cooling thickness im ! + ! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! + ! c_d - coefficient2 to calculate d(tz)/d(ts) im ! + ! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! + ! w_d - coefficient4 to calculate d(tz)/d(ts) im ! + ! ifd - real, index to start dtlm run or not im ! + ! qrain - real, sensible heat flux due to rainfall (watts) im ! + + ! outputs: ! + + ! qsurf - real, surface air saturation specific humidity im ! + ! gflux - real, soil heat flux (w/m**2) im ! + ! cmm - real, im ! + ! chh - real, im ! + ! evap - real, evaperation from latent heat flux im ! + ! hflx - real, sensible heat flux im ! + ! ep - real, potential evaporation im ! + ! ! + ! ===================================================================== ! + + + + ! --- inputs: + integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, nstf_name5 + real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & + epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice + real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & + t1, q1, tref, cm, ch, fm, fm10, & + prsl1, prslki, prsik1, prslk1, xlon, xcosz, & + sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind + real (kind=kind_phys), intent(in) :: timestep + real (kind=kind_phys), intent(in) :: solhr + + ! For sea spray effect + logical, intent(in) :: lseaspray + ! + logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet + integer, dimension(:), intent(in) :: use_lake_model + logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc + + ! --- input/outputs: + ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation + real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & + tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: qsurf, gflux, cmm, chh, evap, hflx, ep + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! + ! locals + ! + integer :: k,i + ! + real (kind=kind_phys), dimension(im) :: q0, qss, rch, rho_a, theta1, tv1, wndmag + + real(kind=kind_phys) :: elocp,tem,cpinv,hvapi + ! + ! nstm related prognostic fields + ! + logical :: flag(im) + real (kind=kind_phys), dimension(im) :: xt_old, xs_old, xu_old, xv_old, xz_old, & + zm_old,xtts_old, xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old + + real(kind=kind_phys) :: ulwflx(im), nswsfc(im) + ! real(kind=kind_phys) rig(im), + ! & ulwflx(im),dlwflx(im), + ! & slrad(im),nswsfc(im) + real(kind=kind_phys) :: alpha,beta,rho_w,f_nsol,sss,sep, cosa,sina,taux,tauy, & + grav,dz,t0,ttop0,ttop + + real(kind=kind_phys) :: le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich + real(kind=kind_phys) :: rnl_ts,hs_ts,hl_ts,rf_ts,q_ts + real(kind=kind_phys) :: fw,q_warm + real(kind=kind_phys) :: t12,alon,tsea,sstc,dta,dtz + real(kind=kind_phys) :: zsea1,zsea2,soltim + logical :: do_nst + ! + ! parameters for sea spray effect + ! + real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, & + bb1, hflxs, evaps, ptem + ! + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, + ! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, + real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & + ws10cr=30., conlf=7.2e-9, consf=6.4e-8 + ! + !====================================================================================================== + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (nstf_name1 == 0) return ! No NSST model used + + cpinv = one/cp + hvapi = one/hvap + elocp = hvap/cp + + sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready + ! + ! flag for open water and where the iteration is on + ! + do_nst = .false. + do i = 1, im + ! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) + flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 + do_nst = do_nst .or. flag(i) + enddo + if (.not. do_nst) return + ! + ! save nst-related prognostic fields for guess run + ! + do i=1, im + ! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then + if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then + xt_old(i) = xt(i) + xs_old(i) = xs(i) + xu_old(i) = xu(i) + xv_old(i) = xv(i) + xz_old(i) = xz(i) + zm_old(i) = zm(i) + xtts_old(i) = xtts(i) + xzts_old(i) = xzts(i) + ifd_old(i) = ifd(i) + tskin_old(i) = tskin(i) + dt_cool_old(i) = dt_cool(i) + z_c_old(i) = z_c(i) + endif + enddo + + + ! --- ... initialize variables. all units are m.k.s. unless specified. + ! ps is in pascals, wind is wind speed, theta1 is surface air + ! estimated from level 1 temperature, rho_a is air density and + ! qss is saturation specific humidity at the water surface + !! + do i = 1, im + if ( flag(i) ) then + + nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) + wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) + + q0(i) = max(q1(i), 1.0e-8_kp) + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer + endif + + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) + rho_a(i) = prsl1(i) / (rd*tv1(i)) + qss(i) = fpvs(tsurf(i)) ! pa + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa + ! + evap(i) = zero + hflx(i) = zero + gflux(i) = zero + ep(i) = zero + + ! --- ... rcp = rho cp ch v + + rch(i) = rho_a(i) * cp * ch(i) * wind(i) + cmm(i) = cm (i) * wind(i) + chh(i) = rho_a(i) * ch(i) * wind(i) + + !> - Calculate latent and sensible heat flux over open water with tskin. + ! at previous time step + evap(i) = elocp * rch(i) * (qss(i) - q0(i)) + qsurf(i) = qss(i) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tsurf(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) + endif + + ! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', + ! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) + ! &,' tsurf=',tsurf(i) + endif + enddo + + ! run nst model: dtm + slm + ! + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + + !> - Call module_nst_water_prop::density() to compute sea water density. + !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion + !! coefficient (\a alpha) and saline contraction coefficient (\a beta). + do i = 1, im + if ( flag(i) ) then + tsea = tsurf(i) + t12 = tsea*tsea + ulwflx(i) = sfcemis(i) * sbc * t12 * t12 + alon = xlon(i)*rad2deg + grav = grv(sinlat(i)) + soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp + call density(tsea,sss,rho_w) ! sea water density + call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta + ! + !> - Calculate sensible heat flux (\a qrain) due to rainfall. + ! + le = (2.501_kp-0.00237_kp*tsea)*1.0e6_kp + dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity + dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) & + * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity + wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) + alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor + tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w + qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) + + !> - Calculate input non solar heat flux as upward = positive to models here + + f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) + omg_sh*qrain(i) + + ! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', + ! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) + ! &,' omg_sh=',omg_sh,' qrain=',qrain(i) + + sep = sss*(evap(i)/le-rain(i))/rho_w + ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity + ! + ! sensitivities of heat flux components to ts + ! + rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) + hs_ts = rch(i) + hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) + rf_ts = tem * (one+rch(i)*hl_ts) + q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts + ! + !> - Call cool_skin(), which is the sub-layer cooling parameterization + !! (Fairfall et al. (1996) \cite fairall_et_al_1996). + ! & calculate c_0, c_d + ! + call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta, & + rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le, & + dt_cool(i),z_c(i),c_0(i),c_d(i)) + + tem = one / wndmag(i) + cosa = u1(i)*tem + sina = v1(i)*tem + taux = max(stress(i),tau_min)*cosa + tauy = max(stress(i),tau_min)*sina + fc = const_rot*sinlat(i) + ! + ! Run DTM-1p system. + ! + if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then + else + ifd(i) = one + ! + ! calculate fcl thickness with current forcing and previous time's profile + ! + ! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) + + !> - Call convdepth() to calculate depth for convective adjustments. + if ( f_nsol > zero .and. xt(i) > zero ) then + call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w, & + alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) + else + d_conv(i) = zero + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) + ! + ! determine rich: wind speed dependent (right now) + ! + ! if ( wind(i) < 1.0 ) then + ! rich = 0.25 + 0.03*wind(i) + ! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then + ! rich = 0.25 + 0.1*wind(i) + ! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then + ! rich = 0.25 + 0.6*wind(i) + ! elseif ( wind(i) >= 6.0 ) then + ! rich = 0.25 + min(0.8*wind(i),0.50) + ! endif + + rich = ri_c + + !> - Call the diurnal thermocline layer model dtm_1p(). + call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), & + f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, & + sinlat(i),soltim,grav,le,d_conv(i), & + xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) + + ! apply mda + if ( xt(i) > zero ) then + !> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply + !! minimum depth adjustment (mda). + call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + !> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. + call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' + ! &,z_w_max + endif + + ! apply fca + if ( d_conv(i) > zero ) then + !> - If thickness of free convection layer > 0.0, call dtm_1p_fca() + !! to apply free convection adjustment. + !> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). + call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) + + ! apply tla + dz = min(xz(i),max(d_conv(i),delz)) + ! + !> - Call sw_ps_9b() to compute the fraction of the solar radiation + !! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). + !! And calculate the total heat absorbed in warm layer. + call sw_ps_9b(delz,fw) + q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer + + !> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with + !! thickness of \a dz. + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho_w,dz, xt(i),xz(i),ttop0) + + ! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', + ! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), + ! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), + ! &' xz=',xz(i),' qrain=',qrain(i) + + ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) + + ! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) + ! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz + ! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 + + !> - Call dtm_1p_tla() to apply top layer adjustment. + if ( ttop > ttop0 ) then + call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', + ! &z_w_max + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + endif ! if ( q_warm > 0.0 ) then + + ! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) + + ! apply mwa + !> - Call dt_1p_mwa() to apply maximum warming adjustment. + t0 = (xt(i)+xt(i))/xz(i) + if ( t0 > tw_max ) then + call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) + + ! apply mta + !> - Call dtm_1p_mta() to apply maximum temperature adjustment. + sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) + + if ( sstc > sst_max ) then + dta = sstc - sst_max + call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) + ! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), + ! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + ! + endif ! if ( xt(i) > 0.0 ) then + ! reset dtl at midnight and when solar zenith angle > 89.994 degree + if ( abs(soltim) < 2.0_kp*timestep ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + + endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day + + ! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) + + ! update tsurf (when flag(i) .eqv. .true. ) + !> - Call get_dtzm_point() to computes \a dtz and \a tsurf. + call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), zsea1,zsea2,dtz) + tsurf(i) = max(tgice, tref(i) + dtz ) + + ! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', + ! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) + + !> - Call cal_w() to calculate \a w_0 and \a w_d. + if ( xt(i) > zero ) then + call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) + else + w_0(i) = zero + w_d(i) = zero + endif + + ! if ( xt(i) > 0.0 ) then + ! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) + ! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) + ! else + ! rig(i) = 0.25 + ! endif + + ! qrain(i) = rig(i) + zm(i) = wind(i) + + endif + enddo + + ! restore nst-related prognostic fields for guess run + do i=1, im + ! if (wet(i) .and. .not.icy(i)) then + if (wet(i) .and. use_lake_model(i)/=1) then + if (flag_guess(i)) then ! when it is guess of + xt(i) = xt_old(i) + xs(i) = xs_old(i) + xu(i) = xu_old(i) + xv(i) = xv_old(i) + xz(i) = xz_old(i) + zm(i) = zm_old(i) + xtts(i) = xtts_old(i) + xzts(i) = xzts_old(i) + ifd(i) = ifd_old(i) + tskin(i) = tskin_old(i) + dt_cool(i) = dt_cool_old(i) + z_c(i) = z_c_old(i) + else + ! + ! update tskin when coupled and not guess run + ! (all other NSST variables have been updated in this case) + ! + if ( nstf_name1 > 1 ) then + tskin(i) = tsurf(i) + endif ! if nstf_name1 > 1 then + endif ! if flag_guess(i) then + endif ! if wet(i) .and. .not.icy(i) then + enddo + + ! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) + + if ( nstf_name1 > 1 ) then + !> - Calculate latent and sensible heat flux over open water with updated tskin + !! for the grids of open water and the iteration is on. + do i = 1, im + if ( flag(i) ) then + qss(i) = fpvs( tskin(i) ) + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) + qsurf(i) = qss(i) + evap(i) = elocp*rch(i) * (qss(i) - q0(i)) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tskin(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) + endif + + endif + enddo + endif ! if ( nstf_name1 > 1 ) then + ! + !> - Include sea spray effects + ! + do i=1,im + if(lseaspray .and. flag(i)) then + f10m = fm10(i) / fm(i) + u10m = f10m * u1(i) + v10m = f10m * v1(i) + ws10 = sqrt(u10m*u10m + v10m*v10m) + ws10 = max(ws10,1.) + ws10 = min(ws10,ws10cr) + tem = .015 * ws10 * ws10 + ru10 = 1. - .087 * log(10./tem) + qss1 = fpvs(t1(i)) + qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) + tem = rd * cp * t1(i) * t1(i) + tem = 1. + eps * hvap * hvap * qss1 / tem + bb1 = 1. / tem + evaps = conlf * (ws10**5.4) * ru10 * bb1 + evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) + evap(i) = evap(i) + alps * evaps + hflxs = consf * (ws10**3.4) * ru10 + hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) + ptem = alps - gams + hflx(i) = hflx(i) + bets * hflxs - ptem * evaps + endif + enddo + ! + do i=1,im + if ( flag(i) ) then + tem = one / rho_a(i) + hflx(i) = hflx(i) * tem * cpinv + evap(i) = evap(i) * tem * hvapi + endif + enddo + ! + ! if (lprnt) print *,' tskin=',tskin(ipr) + + return + end subroutine sfc_nst_run + !> @} +end module sfc_nst diff --git a/physics/sfc_nst_post.f b/physics/sfc_nst_post.f deleted file mode 100644 index 83bc2f273..000000000 --- a/physics/sfc_nst_post.f +++ /dev/null @@ -1,93 +0,0 @@ -!> \file sfc_nst_post.f -!! This file contains code to be executed after the GFS NSST model. - - module sfc_nst_post - - contains - -! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post - -!> \section arg_table_sfc_nst_post_run Argument Table -!! \htmlinclude sfc_nst_post_run.html -!! -! \section NSST_general_post_algorithm General Algorithm -! -! \section NSST_detailed_post_algorithm Detailed Algorithm -! @{ - subroutine sfc_nst_post_run & - & ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & - & oro_uf, nstf_name1, & - & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & - & ) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, kdt, nthreads - logical, dimension(:), intent(in) :: wet, icy - integer, dimension(:), intent(in) :: use_lake_model - real (kind=kind_phys), intent(in) :: rlapse, tgice - real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf - integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 - real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, & - & dt_cool, z_c, tref, xlon - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, & - & tsfc_wat - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: dtzm - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys) :: zsea1, zsea2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), -! & ' kdt=',kdt - -! do i = 1, im -! if (wet(i) .and. .not. icy(i)) then -! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse -! endif -! enddo - -! --- ... run nsst model ... --- - - if (nstf_name1 > 1) then - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & - & im, 1, nthreads, dtzm) - do i = 1, im -! if (wet(i) .and. .not.icy(i)) then -! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. use_lake_model(i) /=1) then - tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) -! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & -! (oro(i)-oro_uf(i))*rlapse - endif - enddo - endif - -! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt - - return - end subroutine sfc_nst_post_run - - end module sfc_nst_post diff --git a/physics/sfc_nst_post.f90 b/physics/sfc_nst_post.f90 new file mode 100644 index 000000000..174d5df76 --- /dev/null +++ b/physics/sfc_nst_post.f90 @@ -0,0 +1,87 @@ +!> \file sfc_nst_post.f90 +!! This file contains code to be executed after the GFS NSST model. + +module sfc_nst_post + + use machine , only : kind_phys, kp => kind_phys + use module_nst_water_prop , only : get_dtzm_2d + + implicit none + +contains + + ! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post + + !> \section arg_table_sfc_nst_post_run Argument Table + !! \htmlinclude sfc_nst_post_run.html + !! + ! \section NSST_general_post_algorithm General Algorithm + ! + ! \section NSST_detailed_post_algorithm Detailed Algorithm + ! @{ + subroutine sfc_nst_post_run & + ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & + oro_uf, nstf_name1, & + nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & + tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & + ) + ! --- inputs: + integer, intent(in) :: im, kdt, nthreads + logical, dimension(:), intent(in) :: wet, icy + integer, dimension(:), intent(in) :: use_lake_model + real (kind=kind_phys), intent(in) :: rlapse, tgice + real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf + integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 + real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, dt_cool, z_c, tref, xlon + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tsfc_wat + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(out) :: dtzm + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys) :: zsea1, zsea2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), + ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), + ! & ' kdt=',kdt + + ! do i = 1, im + ! if (wet(i) .and. .not. icy(i)) then + ! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse + ! endif + ! enddo + + ! --- ... run nsst model ... --- + + if (nstf_name1 > 1) then + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, im, 1, nthreads, dtzm) + do i = 1, im + ! if (wet(i) .and. .not.icy(i)) then + ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then + if (wet(i) .and. use_lake_model(i) /=1) then + tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) + ! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & + ! (oro(i)-oro_uf(i))*rlapse + endif + enddo + endif + + ! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & + ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt + + return + end subroutine sfc_nst_post_run + +end module sfc_nst_post diff --git a/physics/sfc_nst_pre.f b/physics/sfc_nst_pre.f deleted file mode 100644 index 77ff61f00..000000000 --- a/physics/sfc_nst_pre.f +++ /dev/null @@ -1,96 +0,0 @@ -!> \file sfc_nst_pre.f -!! This file contains preparation for the GFS NSST model. - - module sfc_nst_pre - - contains - -!> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre -!! -!! The NSST scheme is one of the three schemes used to represent the -!! surface in the GFS physics suite. The other two are the Noah land -!! surface model and the sice simplified ice model. -!! -!! \section arg_table_sfc_nst_pre_run Argument Table -!! \htmlinclude sfc_nst_pre_run.html -!! -!> \section NSST_general_pre_algorithm General Algorithm - subroutine sfc_nst_pre_run - & (im, wet, tgice, tsfco, tsurf_wat, - & tseal, xt, xz, dt_cool, z_c, tref, cplflx, - & oceanfrac, nthreads, errmsg, errflg) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, nthreads - logical, dimension(:), intent(in) :: wet - real (kind=kind_phys), intent(in) :: tgice - real (kind=kind_phys), dimension(:), intent(in) :: - & tsfco, xt, xz, dt_cool, z_c, oceanfrac - logical, intent(in) :: cplflx - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: - & tsurf_wat, tseal, tref - -! --- outputs: - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys), parameter :: zero = 0.0_kp, - & one = 1.0_kp, - & half = 0.5_kp, - & omz1 = 2.0_kp - real(kind=kind_phys) :: tem1, tem2, dnsst - real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (wet(i) .and. oceanfrac(i) > 0.0) then -! tem = (oro(i)-oro_uf(i)) * rlapse - ! DH* 20190927 simplyfing this code because tem is zero - !tem = zero - !tseal(i) = tsfco(i) + tem - tseal(i) = tsfco(i) - !tsurf_wat(i) = tsurf_wat(i) + tem - ! *DH - endif - enddo -! -! update tsfc & tref with T1 from OGCM & NSST Profile if coupled -! - if (cplflx) then - z_c_0 = zero - call get_dtzm_2d (xt, xz, dt_cool, & - & z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) - do i=1,im - if (wet(i) .and. oceanfrac(i) > zero ) then -! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf - tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile -! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update -! tseal(i) = tsfc_wat(i) - if (abs(xz(i)) > zero) then - tem2 = one / xz(i) - else - tem2 = zero - endif - tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) - tsurf_wat(i) = tseal(i) - endif - enddo - endif - - return - end subroutine sfc_nst_pre_run - end module sfc_nst_pre diff --git a/physics/sfc_nst_pre.f90 b/physics/sfc_nst_pre.f90 new file mode 100644 index 000000000..3e77f2d6b --- /dev/null +++ b/physics/sfc_nst_pre.f90 @@ -0,0 +1,89 @@ +!> \file sfc_nst_pre.f90 +!! This file contains preparation for the GFS NSST model. + +module sfc_nst_pre + + use machine , only : kind_phys + use module_nst_water_prop , only : get_dtzm_2d + use module_nst_parameters , only : zero, one + + implicit none + +contains + + !> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre + !! + !! The NSST scheme is one of the three schemes used to represent the + !! surface in the GFS physics suite. The other two are the Noah land + !! surface model and the sice simplified ice model. + !! + !! \section arg_table_sfc_nst_pre_run Argument Table + !! \htmlinclude sfc_nst_pre_run.html + !! + !> \section NSST_general_pre_algorithm General Algorithm + subroutine sfc_nst_pre_run & + (im, wet, tgice, tsfco, tsurf_wat, & + tseal, xt, xz, dt_cool, z_c, tref, cplflx, & + oceanfrac, nthreads, errmsg, errflg) + + ! --- inputs: + integer, intent(in) :: im, nthreads + logical, dimension(:), intent(in) :: wet + real (kind=kind_phys), intent(in) :: tgice + real (kind=kind_phys), dimension(:), intent(in) :: tsfco, xt, xz, dt_cool, z_c, oceanfrac + logical, intent(in) :: cplflx + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tseal, tref + + ! --- outputs: + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys + real(kind=kind_phys) :: tem2, dnsst + real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,im + if (wet(i) .and. oceanfrac(i) > 0.0) then + ! tem = (oro(i)-oro_uf(i)) * rlapse + ! DH* 20190927 simplyfing this code because tem is zero + !tem = zero + !tseal(i) = tsfco(i) + tem + tseal(i) = tsfco(i) + !tsurf_wat(i) = tsurf_wat(i) + tem + ! *DH + endif + enddo + ! + ! update tsfc & tref with T1 from OGCM & NSST Profile if coupled + ! + if (cplflx) then + z_c_0 = zero + call get_dtzm_2d (xt, xz, dt_cool, z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) + do i=1,im + if (wet(i) .and. oceanfrac(i) > zero ) then + ! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf + tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile + ! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update + ! tseal(i) = tsfc_wat(i) + if (abs(xz(i)) > zero) then + tem2 = one / xz(i) + else + tem2 = zero + endif + tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) + tsurf_wat(i) = tseal(i) + endif + enddo + endif + + return + end subroutine sfc_nst_pre_run +end module sfc_nst_pre From 1fb6b842b4952a37d61426fbd2876d6d8f8ab15a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 28 Nov 2023 17:01:03 +0000 Subject: [PATCH 089/122] Bug fix in metadata --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta | 2 +- physics/MP/GFDL/gfdl_cloud_microphys.meta | 4 +++- physics/MP/Thompson/mp_thompson.meta | 4 +++- physics/MP/{Thompson => }/module_mp_radar.F90 | 0 4 files changed, 7 insertions(+), 3 deletions(-) rename physics/MP/{Thompson => }/module_mp_radar.F90 (100%) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta index 5701909fd..758b9d8b8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_physics_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/GFDL/gfdl_cloud_microphys.meta b/physics/MP/GFDL/gfdl_cloud_microphys.meta index 35b216d4a..719a340e5 100644 --- a/physics/MP/GFDL/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/gfdl_cloud_microphys.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = ../../hooks/machine.F,module_gfdl_cloud_microphys.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index be0720531..ffe34bafb 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = mp_thompson type = scheme - dependencies = ../../hooks/machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/Thompson/module_mp_radar.F90 b/physics/MP/module_mp_radar.F90 similarity index 100% rename from physics/MP/Thompson/module_mp_radar.F90 rename to physics/MP/module_mp_radar.F90 From 562377cc0b337f8f335eb5eec2b68ea3e9ec74e6 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:30:10 -0500 Subject: [PATCH 090/122] remove files from old version --- physics/GFS_ccpp_suite_sim_pre.F90 | 442 ----------------------- physics/GFS_ccpp_suite_sim_pre.meta | 174 --------- physics/ccpp_suite_simulator.F90 | 212 ----------- physics/ccpp_suite_simulator.meta | 201 ----------- physics/module_ccpp_suite_simulator.F90 | 328 ----------------- physics/module_ccpp_suite_simulator.meta | 24 -- 6 files changed, 1381 deletions(-) delete mode 100644 physics/GFS_ccpp_suite_sim_pre.F90 delete mode 100644 physics/GFS_ccpp_suite_sim_pre.meta delete mode 100644 physics/ccpp_suite_simulator.F90 delete mode 100644 physics/ccpp_suite_simulator.meta delete mode 100644 physics/module_ccpp_suite_simulator.F90 delete mode 100644 physics/module_ccpp_suite_simulator.meta diff --git a/physics/GFS_ccpp_suite_sim_pre.F90 b/physics/GFS_ccpp_suite_sim_pre.F90 deleted file mode 100644 index fbaf5a1d9..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.F90 +++ /dev/null @@ -1,442 +0,0 @@ -! ######################################################################################## -! -! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. -! -! Contains: -! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. -! called once during model initialization -! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for -! ccpp_suite_simulator. -! -! ######################################################################################## -module GFS_ccpp_suite_sim_pre - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process - use netcdf - implicit none - public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim -contains - - ! ###################################################################################### - ! - ! SUBROUTINE GFS_ccpp_suite_sim_pre_run - ! - ! ###################################################################################### -!! \section arg_table_GFS_ccpp_suite_sim_pre_run -!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html -!! - subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & - index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & - index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & - index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & - physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & - errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:,:) :: dtend - type(base_physics_process),intent(in) :: physics_process(:) - integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q - - ! Outputs - real(kind_phys), intent(out) :: active_phys_tend(:,:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: idtend, iactive - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Get tendency for "active" process. - - ! ###################################################################################### - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics suites. Not all suites output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some - ! interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option - ! "fhzero". For this to work, you need to clear the diagnostic buckets after each - ! physics timestep when running in the UFS/SCM. - ! - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - ! ###################################################################################### - if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave - if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave - if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl - if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd - if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv - if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv - if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp - - ! Heat - idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp - endif - - ! u-wind - idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp - endif - - ! v-wind - idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp - endif - - ! Moisture - idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp - endif - - end subroutine GFS_ccpp_suite_sim_pre_run - - ! ###################################################################################### - subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & - iactive_u, iactive_v, iactive_q, errmsg, errflg) - - ! Inputs - integer, intent (in) :: nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - type(base_physics_process),intent(inout),allocatable :: physics_process(:) - integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q - integer, intent(out) :: errflg - character(len=256), intent(out) :: errmsg - - ! Local variables - integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data - character(len=256) :: suite_sim_file - logical :: exists, do_ccpp_suite_sim - integer :: nprc_sim - - ! For each process there is a corresponding namelist entry, which is constructed as - ! follows: - ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - prc_LWRAD_cfg = (/0,0,0/), & - prc_SWRAD_cfg = (/0,0,0/), & - prc_PBL_cfg = (/0,0,0/), & - prc_GWD_cfg = (/0,0,0/), & - prc_SCNV_cfg = (/0,0,0/), & - prc_DCNV_cfg = (/0,0,0/), & - prc_cldMP_cfg = (/0,0,0/) - - ! Namelist - namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & - prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & - prc_DCNV_cfg, prc_cldMP_cfg - - errmsg = '' - errflg = 0 - - ! Read in namelist - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) - close (nlunit) - - ! Only proceed if suite simulator requested. - if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & - prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & - prc_cldMP_cfg(1) == 1 ) then - else - return - endif - - ! Check that input data file exists. - inquire (file = trim (suite_sim_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' - errflg = 1 - return - endif - - ! - ! Read data file... - ! - - ! Open file - status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) - errflg = 1 - return - endif - - ! Metadata (dimensions) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' - errflg = 1 - return - endif - - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' - errflg = 1 - return - endif - - ! Allocate space and read in data - allocate(physics_process(nprc_sim)) - physics_process(1)%active_name = '' - physics_process(1)%iactive_scheme = 0 - physics_process(1)%active_tsp = .false. - do iprc = 1,nprc_sim - allocate(physics_process(iprc)%tend1d%T( nlev_data )) - allocate(physics_process(iprc)%tend1d%u( nlev_data )) - allocate(physics_process(iprc)%tend1d%v( nlev_data )) - allocate(physics_process(iprc)%tend1d%q( nlev_data )) - allocate(physics_process(iprc)%tend2d%time( ntime_data)) - allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) - - ! Temporal info - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) - else - errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' - errflg = 1 - return - endif - - if (iprc == prc_SWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (prc_SWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_SWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_LWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (prc_LWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_LWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_GWD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (prc_GWD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 3 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - endif - if (prc_GWD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_PBL_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (prc_PBL_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_PBL_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_SCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (prc_SCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_SCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_DCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (prc_DCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_DCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_cldMP_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (prc_cldMP_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 2 - iactive_T = 1 - iactive_q = 2 - endif - if (prc_cldMP_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - ! Which process-suite is "active"? Is process time-split? - if (.not. physics_process(iprc)%use_sim) then - physics_process(1)%iactive_scheme = iprc - physics_process(1)%active_name = physics_process(iprc)%name - if (physics_process(iprc)%time_split) then - physics_process(1)%active_tsp = .true. - endif - endif - - enddo - - if (physics_process(1)%iactive_scheme == 0) then - errflg = 1 - errmsg = "ERROR: No active suite set for CCPP suite simulator" - return - endif - - print*, "-----------------------------------" - print*, "--- Using CCPP suite simulator ---" - print*, "-----------------------------------" - do iprc = 1,nprc_sim - if (physics_process(iprc)%use_sim) then - print*," simulate_suite: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_suite: ", trim(physics_process(1)%active_name) - print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order - print*, " time_split : ", physics_process(1)%active_tsp - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" - - end subroutine load_ccpp_suite_sim - -end module GFS_ccpp_suite_sim_pre diff --git a/physics/GFS_ccpp_suite_sim_pre.meta b/physics/GFS_ccpp_suite_sim_pre.meta deleted file mode 100644 index cc73813fa..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.meta +++ /dev/null @@ -1,174 +0,0 @@ -[ccpp-table-properties] - name = GFS_ccpp_suite_sim_pre - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -######################################################################## -[ccpp-arg-table] - name = GFS_ccpp_suite_sim_pre_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_longwave] - standard_name = index_of_longwave_heating_process_in_cumulative_change_index - long_name = index of longwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_shortwave] - standard_name = index_of_shortwave_heating_process_in_cumulative_change_index - long_name = index of shortwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_pbl] - standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index - long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_mp] - standard_name = index_of_microphysics_process_process_in_cumulative_change_index - long_name = index of microphysics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = out -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/ccpp_suite_simulator.F90 b/physics/ccpp_suite_simulator.F90 deleted file mode 100644 index c1592263d..000000000 --- a/physics/ccpp_suite_simulator.F90 +++ /dev/null @@ -1,212 +0,0 @@ -! ######################################################################################## -! -! Description: This suite simulates the evolution of the internal physics state -! represented by a CCPP Suite Definition File (SDF). -! -! To activate this suite it must be a) embedded within the SDF and b) activated through -! the physics namelist. -! The derived-data type "base_physics_process" contains the metadata needed to reconstruct -! the temporal evolution of the state. An array of base_physics_process, physics_process, -! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the suite simulator(s). -! -! For this initial demonstration we are using 2-dimensional (height, time) forcing data, -! which is on the same native vertical grid as the SCM. The dataset has a temporal -! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool -! International Cloud Experiment (TWPICE) case. This was to create a dataset with a -! (constant) diurnal cycle. -! -! ######################################################################################## -module ccpp_suite_simulator - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & - sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP - implicit none - public ccpp_suite_simulator_run -contains - - ! ###################################################################################### - ! - ! SUBROUTINE ccpp_suite_simulator_run - ! - ! ###################################################################################### -!! \section arg_table_ccpp_suite_simulator_run -!! \htmlinclude ccpp_suite_simulator_run.html -!! - subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & - iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& - in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& - gv0, gq0, errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & - iactive_v, iactive_q - real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & - active_phys_tend(:,:,:) - ! Outputs - type(base_physics_process),intent(inout) :: physics_process(:) - real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(inout) :: proc_start, proc_end - logical, intent(inout) :: in_pre_active, in_post_active - - ! Locals - integer :: iCol, year, month, day, hour, min, sec, iprc - real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Current forecast time (Data-format specific) - year = jdat(1) - month = jdat(2) - day = jdat(3) - hour = jdat(5) - min = jdat(6) - sec = jdat(7) - - ! Set state at beginning of the physics timestep. - gt1(:,:) = tgrs(:,:) - gu1(:,:) = ugrs(:,:) - gv1(:,:) = vgrs(:,:) - gq1(:,:) = qgrs(:,:,1) - dTdt(:,:) = 0. - dudt(:,:) = 0. - dvdt(:,:) = 0. - dqdt(:,:) = 0. - - ! - ! Set bookeeping indices - ! - if (in_pre_active) then - proc_start = 1 - proc_end = max(1,physics_process(1)%iactive_scheme-1) - endif - if (in_post_active) then - proc_start = physics_process(1)%iactive_scheme - proc_end = size(physics_process) - endif - - ! - ! Simulate internal physics timestep evolution. - ! - do iprc = proc_start,proc_end - do iCol = 1,nCol - - ! Reset locals - physics_process(iprc)%tend1d%T(:) = 0. - physics_process(iprc)%tend1d%u(:) = 0. - physics_process(iprc)%tend1d%v(:) = 0. - physics_process(iprc)%tend1d%q(:) = 0. - - ! Using scheme simulator - ! Very simple... - ! Interpolate 2D data (time,level) tendency to local time. - ! Here the data is already on the SCM vertical coordinate. - ! - ! In theory the data can be of any dimensionality and the onus falls on the - ! developer to extend the type "base_physics_process" to work with for their - ! application. - ! - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%name == "LWRAD") then - call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SWRAD")then - call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "GWD")then - call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "PBL")then - call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SCNV")then - call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "DCNV")then - call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "cldMP")then - call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) - endif - - ! Using data tendency from "active" scheme(s). - else - if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) - if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) - if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) - if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) - endif - - ! Update state now? (time-split scheme) - if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:) = 0. - ! Accumulate tendencies, update later? (process-split scheme) - else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v - dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q - endif - enddo ! END: Loop over columns - - ! Print diagnostics - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' - endif - else - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' - endif - write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active - endif - enddo ! END: Loop over physics processes - - ! - ! Update state with accumulated tendencies (process-split only) - ! (Suites where active scheme is last physical process) - ! - iprc = minval([iprc,proc_end]) - if (.not. physics_process(iprc)%time_split) then - do iCol = 1,nCol - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp - enddo - endif - - ! - ! Update bookeeping indices - ! - if (in_pre_active) then - in_pre_active = .false. - in_post_active = .true. - endif - - if (size(physics_process) == proc_end) then - in_pre_active = .true. - in_post_active = .false. - endif - - end subroutine ccpp_suite_simulator_run - -end module ccpp_suite_simulator diff --git a/physics/ccpp_suite_simulator.meta b/physics/ccpp_suite_simulator.meta deleted file mode 100644 index bfa664922..000000000 --- a/physics/ccpp_suite_simulator.meta +++ /dev/null @@ -1,201 +0,0 @@ -[ccpp-table-properties] - name = ccpp_suite_simulator - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -[ccpp-arg-table] - name = ccpp_suite_simulator_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[kdt] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLay] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[jdat] - standard_name = date_and_time_of_forecast_in_united_states_order - long_name = current forecast date and time - units = none - dimensions = (8) - type = integer - intent = in -[proc_start] - standard_name = index_for_first_physics_process_in_CCPP_suite_simulator - long_name = index for first physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[proc_end] - standard_name = index_for_last_physics_process_in_CCPP_suite_simulator - long_name = index for last physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme - long_name = flag to indicate location in physics process loop before active scheme - units = flag - dimensions = () - type = logical - intent = inout -[in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme - long_name = flag to indicate location in physics process loop after active scheme - units = flag - dimensions = () - type = logical - intent = inout -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = in -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gq0] - standard_name = specific_humidity_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/module_ccpp_suite_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 deleted file mode 100644 index c4f9fc4e4..000000000 --- a/physics/module_ccpp_suite_simulator.F90 +++ /dev/null @@ -1,328 +0,0 @@ -! ######################################################################################## -! -! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp suite simulator. -! -! ######################################################################################## -module module_ccpp_suite_simulator -!> \section arg_table_module_ccpp_suite_simulator Argument table -!! \htmlinclude module_ccpp_suite_simulator.html -!! - use machine, only : kind_phys - implicit none - - public base_physics_process - - ! Type containing 1D (time) physics tendencies. - type phys_tend_1d - real(kind_phys), dimension(:), allocatable :: T - real(kind_phys), dimension(:), allocatable :: u - real(kind_phys), dimension(:), allocatable :: v - real(kind_phys), dimension(:), allocatable :: q - real(kind_phys), dimension(:), allocatable :: p - real(kind_phys), dimension(:), allocatable :: z - end type phys_tend_1d - - ! Type containing 2D (lev,time) physics tendencies. - type phys_tend_2d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: T - real(kind_phys), dimension(:,:), allocatable :: u - real(kind_phys), dimension(:,:), allocatable :: v - real(kind_phys), dimension(:,:), allocatable :: q - real(kind_phys), dimension(:,:), allocatable :: p - real(kind_phys), dimension(:,:), allocatable :: z - end type phys_tend_2d - - ! Type containing 3D (loc,lev,time) physics tendencies. - type phys_tend_3d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:), allocatable :: lon - real(kind_phys), dimension(:), allocatable :: lat - real(kind_phys), dimension(:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:), allocatable :: q - end type phys_tend_3d - - ! Type containing 4D (lon,lat,lev,time) physics tendencies. - type phys_tend_4d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: lon - real(kind_phys), dimension(:,:), allocatable :: lat - real(kind_phys), dimension(:,:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:,:), allocatable :: q - end type phys_tend_4d - -! This type contains the meta information and data for each physics process. - -!> \section arg_table_base_physics_process Argument Table -!! \htmlinclude base_physics_process.html -!! - type base_physics_process - character(len=16) :: name ! Physics process name - logical :: time_split = .false. ! Is process time-split? - logical :: use_sim = .false. ! Is process "active"? - integer :: order ! Order of process in process-loop - type(phys_tend_1d) :: tend1d ! Instantaneous data - type(phys_tend_2d) :: tend2d ! 2-dimensional data - type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. - type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. - character(len=16) :: active_name ! "Active" scheme: Physics process name - integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop - logical :: active_tsp ! "Active" scheme: Is process time-split? - integer :: nprg_active ! "Active" scheme: Number of prognostic variables - contains - generic, public :: linterp => linterp_1D, linterp_2D - procedure, private :: linterp_1D - procedure, private :: linterp_2D - procedure, public :: find_nearest_loc_2d_1d - procedure, public :: cmp_time_wts - end type base_physics_process - -contains - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: err_message - integer :: ti(1), tf(1), ntime - real(kind_phys) :: w1, w2 - - ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ntime = size(this%tend2d%T(1,:)) - - select case(var_name) - case("T") - if (tf(1) .le. ntime) then - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) - else - this%tend1d%T = this%tend2d%T(:,1) - endif - case("u") - if (tf(1) .le. ntime) then - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) - else - this%tend1d%u = this%tend2d%u(:,1) - endif - case("v") - if (tf(1) .le. ntime) then - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) - else - this%tend1d%v = this%tend2d%v(:,1) - endif - case("q") - if (tf(1) .le. ntime) then - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) - else - this%tend1d%q = this%tend2d%q(:,1) - endif - end select - - end function linterp_1D - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] allocated with - ! each location. - ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - real(kind_phys), intent(in) :: lon, lat - character(len=128) :: err_message - integer :: ti(1), tf(1), iNearest - real(kind_phys) :: w1, w2 - - ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ! Grab data tendency closest to column [lon,lat] - iNearest = this%find_nearest_loc_2d_1d(lon,lat) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) - end select - end function linterp_2D - - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### - pure function find_nearest_loc_2d_1d(this, lon, lat) - class(base_physics_process), intent(in) :: this - real(kind_phys), intent(in) :: lon, lat - integer :: find_nearest_loc_2d_1d - - find_nearest_loc_2d_1d = 1 - end function find_nearest_loc_2d_1d - - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) - ! Inputs - class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, sec - ! Outputs - integer,intent(out) :: ti(1), tf(1) - real(kind_phys),intent(out) :: w1, w2 - ! Locals - real(kind_phys) :: hrofday - - hrofday = hour*3600. + minute*60. + sec - ti = max(hour,1) - tf = min(ti + 1,24) - w1 = ((hour+1)*3600 - hrofday)/3600 - w2 = 1 - w1 - - end subroutine cmp_time_wts - - ! #################################################################################### - ! #################################################################################### - subroutine sim_LWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_LWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_SWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_GWD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - - end subroutine sim_GWD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_PBL( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_PBL - - ! #################################################################################### - ! #################################################################################### - subroutine sim_DCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_DCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_SCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_cldMP( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - end subroutine sim_cldMP - -end module module_ccpp_suite_simulator diff --git a/physics/module_ccpp_suite_simulator.meta b/physics/module_ccpp_suite_simulator.meta deleted file mode 100644 index cd8e3db1b..000000000 --- a/physics/module_ccpp_suite_simulator.meta +++ /dev/null @@ -1,24 +0,0 @@ -[ccpp-table-properties] - name = base_physics_process - type = ddt - dependencies = - -[ccpp-arg-table] - name = base_physics_process - type = ddt - -######################################################################## -[ccpp-table-properties] - name = module_ccpp_suite_simulator - type = module - dependencies = machine.F - -[ccpp-arg-table] - name = module_ccpp_suite_simulator - type = module -[base_physics_process] - standard_name = base_physics_process - long_name = definition of type base_physics_process - units = DDT - dimensions = () - type = base_physics_process From 12cd9c698ad9bc97bb4c84a2225542ccaf0ce3bc Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:35:12 -0500 Subject: [PATCH 091/122] update files satmedmfvdifq.F samfshalcnv.f sfc_diff.f --- physics/samfshalcnv.f | 2 +- physics/satmedmfvdifq.F | 2 +- physics/scm_sfc_flux_spec.F90 | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 3869ea6ea..d0bab05dd 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -191,7 +191,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,shevf=2.0) parameter(dtmax=10800.,dtmin=600.) parameter(bb1=4.0,bb2=0.8,csmf=0.2) - parameter(tkcrt=2.,cmxfac=15.) + parameter(tkcrt=2.,cmxfac=10.) ! parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 73fc4aff8..7b54b6d12 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -271,7 +271,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=1000.) parameter(qlcr=3.5e-5,zstblmax=2500.) - parameter(xkinv1=0.15,xkinv2=0.3) + parameter(xkinv1=0.4,xkinv2=0.3) parameter(h1=0.33333333,hcrinv=250.) parameter(vegflo=0.1,vegfup=1.0,z0lo=0.1,z0up=1.0) parameter(vc0=1.0,zc0=1.0) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index e835b77ff..835b468ff 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:), use_lake_model(:) + integer, intent(inout) :: islmsk(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) From c6ba923815172c07652e0c0536dea9628bb10d08 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 1 Dec 2023 18:32:56 +0000 Subject: [PATCH 092/122] "Add GF convective transport & wet removal of smoke/dust" --- physics/cu_gf_deep.F90 | 256 +++++++++++++++++++++++++++++---- physics/cu_gf_driver.F90 | 22 ++- physics/cu_gf_driver.meta | 38 +++++ physics/cu_gf_driver_post.F90 | 11 +- physics/cu_gf_driver_post.meta | 44 ++++++ physics/cu_gf_driver_pre.F90 | 10 ++ physics/cu_gf_driver_pre.meta | 44 ++++++ 7 files changed, 395 insertions(+), 30 deletions(-) diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 0d1fc68c7..ab72c662c 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -3,6 +3,7 @@ module cu_gf_deep use machine , only : kind_phys + use physcons, only : qamin real(kind=kind_phys), parameter::g=9.81 real(kind=kind_phys), parameter:: cp=1004. real(kind=kind_phys), parameter:: xlv=2.5e6 @@ -124,6 +125,11 @@ subroutine cu_gf_deep_run( & ,frh_out & ! fractional coverage ,ierr & ! ierr flags are error flags, used for debugging ,ierrc & ! the following should be set to zero if not available + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist ,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist @@ -144,7 +150,7 @@ subroutine cu_gf_deep_run( & ,intent (in ) :: & nranflag,itf,ktf,its,ite, kts,kte,ipr,imid integer, intent (in ) :: & - ichoice + ichoice,nchem real(kind=kind_phys), dimension (its:ite,4) & ,intent (in ) :: rand_clos real(kind=kind_phys), dimension (its:ite) & @@ -163,17 +169,17 @@ subroutine cu_gf_deep_run( & ! outq = output q tendency (per s) ! outqc = output qc tendency (per s) ! pre = output precip - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & cnvwt,outu,outv,outt,outq,outqc,cupclw - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (out ) :: & frh_out - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & pre,xmb_out !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & hfx,qfx,xmbm_in,xmbs_in !$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) @@ -190,29 +196,35 @@ subroutine cu_gf_deep_run( & ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & dhdt,rho,t,po,us,vs,tn !$acc declare copyin(dhdt,rho,t,po,us,vs,tn) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & omeg !$acc declare copy(omeg) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout) :: & q,qo,zuo,zdo,zdm !$acc declare copy(q,qo,zuo,zdo,zdm) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & dx,z1,psur,xland !$acc declare copyin(dx,z1,psur,xland) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) & + ,intent (inout) :: & + chem3d + logical, intent (in) :: do_smoke_transport + real(kind=kind_phys), dimension (its:ite,nchem) & + , intent (out) :: wetdpc_deep + real(kind=kind_phys), intent (in) :: fscav(:) - - real(kind=kind_phys) & + real(kind=kind_phys) & ,intent (in ) :: & dtime,ccnclean @@ -220,11 +232,11 @@ subroutine cu_gf_deep_run( & ! ! local ensemble dependent variables in this routine ! - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & xaa0_ens - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & edtc - real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens !$acc declare create(xaa0_ens,edtc,dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens) ! @@ -292,8 +304,18 @@ subroutine cu_gf_deep_run( & ! xmb = total base mass flux ! hc = cloud moist static energy ! hkb = moist static energy at originating level - - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd + real(kind=kind_phys), dimension (its:ite,nchem) :: & + chem_pwav,chem_psum + real(kind=kind_phys):: dtime_max,sum1,sum2 + real(kind=kind_phys), dimension (kts:kte) :: trac,trcflx_in,trcflx_out,trc,trco + real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx + integer :: nv + + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & xhe,xhes,xqes,xz,xt,xq,qes_cup,q_cup,he_cup,hes_cup,z_cup, & p_cup,gamma_cup,t_cup, qeso_cup,qo_cup,heo_cup,heso_cup, & @@ -330,13 +352,13 @@ subroutine cu_gf_deep_run( & ! xaa0 = cloud work function with cloud effects (ensemble dependent) ! edt = epsilon - real(kind=kind_phys), dimension (its:ite) :: & - edt,edto,edtm,aa1,aa0,xaa0,hkb, & + real(kind=kind_phys), dimension (its:ite) :: & + edt,edto,edtm,aa1,aa0,xaa0,hkb, & hkbo,xhkb, & xmb,pwavo,ccnloss, & pwevo,bu,bud,cap_max, & cap_max_increment,closure_n,psum,psumh,sig,sigd - real(kind=kind_phys), dimension (its:ite) :: & + real(kind=kind_phys), dimension (its:ite) :: & axx,edtmax,edtmin,entr_rate integer, dimension (its:ite) :: & kzdown,kdet,k22,jmin,kstabi,kstabm,k22x,xland1, & @@ -372,10 +394,10 @@ subroutine cu_gf_deep_run( & character*50 :: ierrc(its:ite) character*4 :: cumulus - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentr,up_massdetr,c1d & ,up_massentro,up_massdetro,dd_massentro,dd_massdetro - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentru,up_massdetru,dd_massentru,dd_massdetru !$acc declare create(up_massentr,up_massdetr,c1d,up_massentro,up_massdetro,dd_massentro,dd_massdetro, & !$acc up_massentru,up_massdetru,dd_massentru,dd_massdetru) @@ -401,6 +423,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,kts:kte) :: dtempdz integer, dimension (its:ite,kts:kte) :: k_inv_layers real(kind=kind_phys), dimension (its:ite) :: c0 ! HCB + real(kind=kind_phys), dimension (its:ite,kts:kte) :: c0t3d ! hli for smoke/dust wet scavenging !$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0) ! rainevap from sas @@ -1058,14 +1081,14 @@ subroutine cu_gf_deep_run( & if(imid.eq.1)then call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) else call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) @@ -2013,6 +2036,185 @@ subroutine cu_gf_deep_run( & kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, & po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) +! +! +!>- atmospheric composition tracers +! +!> ## Determine whether to perform aerosol transport + if (do_smoke_transport .and. nchem > 0) then +! +! initialize tracers if they exist +! + chem (:,:,:) = 0. + do nv = 1,nchem + do k = 1, ktf + do i = 1, itf + chem(i,k,nv) = max(qamin, chem3d(i,k,nv)) + enddo + enddo + enddo + + wetdpc_deep = 0. + + chem_pwav(:,:) = 0. + chem_psum(:,:) = 0. + chem_pw (:,:,:) = 0. + chem_pwd (:,:,:) = 0. + pwdper (:,:) = 0. + chem_down(:,:,:) = 0. + chem_up (:,:,:) = 0. + chem_c (:,:,:) = 0. + chem_cup (:,:,:) = 0. + + do i=its,itf + if(ierr(i).eq.0)then + do k=kts,jmin(i) + pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) + enddo + pwdper(i,:)=0. + do nv=1,nchem + do k=kts+1,ktf + chem_cup(i,k,nv)=.5*(chem(i,k-1,nv)+chem(i,k,nv)) + enddo + chem_cup(i,kts,nv)=chem(i,kts,nv) +! +! in updraft +! + do k=1,k22(i) + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo + do k=k22(i)+1,ktop(i) + chem_up(i,k,nv)=(chem_up(i,k-1,nv)*zuo(i,k-1) & + -.5*up_massdetr(i,k-1)*chem_up(i,k-1,nv)+ & + up_massentr(i,k-1)*chem(i,k-1,nv)) / & + (zuo(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) + chem_c(i,k,nv)=fscav(nv)*chem_up(i,k,nv) + dz=zo_cup(i,K)-zo_cup(i,K-1) + trash2=chem_up(i,k,nv)-chem_c(i,k,nv) + trash=chem_c(i,k,nv)/(1.+c0t3d(i,k)*dz) + chem_pw=c0t3d(i,k)*dz*trash*zuo(i,k) + chem_up(i,k,nv)=trash2+trash +! chem_pw(i,k,nv)=min(chem_up(i,k,nv),chem_c(i,k,nv)*pwo(i,k)/zuo(i,k)/(1.e-8+qrco(i,k))) +! chem_up(i,k,nv)=chem_up(i,k,nv)-chem_pw(i,k,nv) + chem_pwav(i,nv)=chem_pwav(i,nv)+chem_pw(i,k,nv)! *g/dp + enddo + do k=ktop(i)+1,ktf + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo +! +! in downdraft +! + chem_down(i,jmin(i)+1,nv)=chem_cup(i,jmin(i)+1,nv) + chem_psum(i,nv)=0. + do ki=jmin(i),2,-1 + dp=100.*(po_cup(i,ki)-po_cup(i,ki+1)) + chem_down(i,ki,nv)=(chem_down(i,ki+1,nv)*zdo(i,ki+1) & + -.5*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & + dd_massentro(i,ki)*chem(i,ki,nv)) / & + (zdo(i,ki+1)-.5*dd_massdetro(i,ki)+dd_massentro(i,ki)) + chem_down(i,ki,nv)=chem_down(i,ki,nv)+pwdper(i,ki)*chem_pwav(i,nv) + chem_pwd(i,ki,nv)=max(0.,pwdper(i,ki)*chem_pwav(i,nv)) + enddo +! total wet deposition + do k=1,ktf-1 + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + chem_psum(i,nv)=chem_psum(i,nv)+chem_pw(i,k,nv)*g !/dp + enddo + chem_psum(i,nv)=chem_psum(i,nv)*xmb(i)*dtime +! + enddo ! nchem + endif ! ierr=0 + enddo ! i + + dellac(:,:,:)=0. + + do nv=1,nchem + do i=its,itf + if(ierr(i).eq.0)then + dp=100.*(po_cup(i,1)-po_cup(i,2)) + dellac(i,1,nv)=dellac(i,1,nv)+(edto(i)*zdo(i,2)*chem_down(i,2,nv))*g/dp*xmb(i) + if(k22(i).eq.2)then + entupk=zuo(i,2) + dellac(i,1,nv)=dellac(i,1,nv)-entupk*chem_cup(i,2,nv)*g/dp*xmb(i) + endif + do k=kts+1,ktop(i)-1 + detup=0. + detdo=0. + entup=0. + entdo=0. + entdoj=0. + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + ! entrainment/detrainment for updraft + entdo=edto(i)*dd_massentro(i,k)*chem(i,k,nv) + detdo=edto(i)*dd_massdetro(i,k)*.5*(chem_down(i,k+1,nv)+chem_down(i,k,nv)) + entup=up_massentro(i,k)*chem(i,k,nv) + detup=up_massdetro(i,k)*.5*(chem_up(i,k+1,nv)+chem_up(i,k,nv)) + ! special levels + if(k == k22(i)-1) then + entup=zuo(i,k+1)*chem_cup(i,k+1,nv) + detup=0. + endif + if(k.eq.jmin(i))entdoj=edto(i)*zdo(i,k)*chem_cup(i,k,nv) +! mass budget + dellac(i,k,nv) =dellac(i,k,nv) + (detup+detdo-entdo-entup-entdoj)*g/dp*xmb(i) + enddo + dellac(i,ktop(i),nv)=zuo(i,ktop(i))*chem_up(i,ktop(i),nv)*g/dp*xmb(i) + endif ! ierr + enddo ! i + enddo ! nchem loop + +! fct for subsidence + dellac2(:,:,:)=0. + massflx(:,:)=0. + do nv=1,nchem + do i=its,itf + if(ierr(i).eq.0)then + trcflx_in(:)=0. + dtime_max=dtime + +! initialize fct routine + do k=kts,ktop(i) + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + dtime_max=min(dtime_max,.5*dp) + massflx(i,k)=-xmb(i)*(zuo(i,k)-edto(i)*zdo(i,k)) + trcflx_in(k)=massflx(i,k)*chem_cup(i,k,nv) + enddo + trcflx_in(1)=0. + massflx(i,1)=0. + call fct1d3(ktop(i),kte,dtime_max,po_cup(i,:),chem(i,:,nv),massflx(i,:), & + trcflx_in,dellac2(i,:,nv),g) + do k=kts,ktop(i) + trash=chem (i,k,nv) + chem (i,k,nv)=chem (i,k,nv) + (dellac(i,k,nv)+dellac2(i,k,nv))*dtime + if(chem(i,k,nv).lt.qamin)then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv)+(qamin-chem(i,k,nv))*dp/g/dtime + chem(i,k,nv)=qamin + endif + enddo + endif + + enddo ! i + enddo ! nchem loop + +!> - Store aerosol concentrations if present + do nv = 1, nchem + do i = 1, itf + do k = 1, ktf + if(ierr(i).eq.0) then + if (k <= ktop(i)) then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv) + ((chem3d(i,k,nv)-chem(i,k,nv))*dp/(g*dtime)) + chem3d(i,k,nv) = chem(i,k,nv) + endif + endif + enddo + wetdpc_deep(i,nv)=max(wetdpc_deep(i,nv),qamin) + enddo + enddo + + endif ! nchem > 0 + k=1 !$acc kernels do i=its,itf @@ -4101,7 +4303,7 @@ end subroutine cup_output_ens_3d !> Calculates moisture properties of the updraft. subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & - q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, & + q,gamma_cup,zu,qes_cup,k22,qe_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,t,autoconv, & up_massentr,up_massdetr,psum,psumh, & itest,itf,ktf, & @@ -4137,6 +4339,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & zqexec,c0 + real(kind=kind_phys), dimension (its:ite,kts:kte), intent (out) :: c0t3d ! entr= entrainment rate integer, dimension (its:ite) & ,intent (in ) :: & @@ -4218,6 +4421,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0_iceconv=0.01 c1d_b=c1d bdsp(:)=bdispm + c0t3d = 0. ! !--- no precip for small clouds @@ -4288,6 +4492,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & else c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif + c0t3d(i,k)=c0t qc(i,k)= (qc(i,k-1)*zu(i,k-1)-.5*up_massdetr(i,k-1)* qc(i,k-1)+ & up_massentr(i,k-1)*q(i,k-1)) / & (zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) @@ -4320,6 +4525,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif if(is_mid)c0t=0.004 + c0t3d(i,k)=c0t if(autoconv .gt.1) c0t=c0(i) denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index d85b7ac52..d8bc11629 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -67,8 +67,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & - spp_cu_deep,spp_wts_cu_deep, & - errmsg,errflg) + spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & + do_smoke_transport,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -86,7 +86,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& & spp_wts_cu_deep real(kind=kind_phys) :: spp_wts_cu_deep_tmp - logical, intent(in) :: do_cap_suppress + logical, intent(in) :: do_cap_suppress, do_smoke_transport real(kind=kind_phys), parameter :: aodc0=0.14 real(kind=kind_phys), parameter :: aodreturn=30. real(kind=kind_phys) :: dts,fpi,fp @@ -94,7 +94,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: dicycle_m=0 !- diurnal cycle flag integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- - integer :: its,ite, jts,jte, kts,kte + integer :: its,ite, jts,jte, kts,kte, nchem integer, intent(in ) :: im,km,ntracer integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf @@ -154,6 +154,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: imfshalcnv integer, dimension(:), intent(inout) :: cactiv,cactiv_m + real(kind_phys), dimension(:), intent(in) :: fscav + real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d + real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep !$acc declare copy(cactiv,cactiv_m) character(len=*), intent(out) :: errmsg @@ -179,6 +182,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 + real(kind=kind_phys), dimension (im,nchem) :: wetdpc_mid integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm @@ -743,6 +747,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,frhm & ,ierrm & ,ierrcm & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_mid & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist @@ -825,6 +834,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,frhd & ,ierr & ,ierrc & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 08e9de201..d6d874f7e 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -612,6 +612,44 @@ dimensions = () type = integer intent = in +[nchem] + standard_name = number_of_chemical_species_vertically_mixed + long_name = number of chemical vertically mixed + units = count + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[fscav] + standard_name = smoke_dust_conv_wet_coef + long_name = smoke dust convetive wet scavanging coefficents + units = none + dimensions = (3) + type = real + kind = kind_phys + intent = in +[do_smoke_transport] + standard_name = do_smoke_conv_transport + long_name = flag for rrfs smoke convective transport + units = flag + dimensions = () + type = logical + intent = in +[wetdpc_deep] + standard_name = conv_wet_deposition_smoke_dust + long_name = convective wet removal of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 111bf0863..1700fbde9 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -15,7 +15,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) use machine, only: kind_phys @@ -31,6 +31,9 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: cactiv_m(:) real(kind_phys), intent(out) :: conv_act(:) real(kind_phys), intent(out) :: conv_act_m(:) + logical, intent(in) :: rrfs_sd + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm + real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) integer, intent(out) :: errflg @@ -60,6 +63,12 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m enddo !$acc end kernels + if (rrfs_sd) then + gq0(:,:,ntsmoke ) = chem3d(:,:,1) + gq0(:,:,ntdust ) = chem3d(:,:,2) + gq0(:,:,ntcoarsepm) = chem3d(:,:,3) + endif + end subroutine cu_gf_driver_post_run end module cu_gf_driver_post diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 6c6ceeb66..4c04224dc 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -83,6 +83,34 @@ type = real kind = kind_phys intent = out +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer + intent = in +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer + intent = in +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -91,6 +119,22 @@ type = character kind = len=* intent = out +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errflg] standard_name = ccpp_error_code long_name = error code for error handling in CCPP diff --git a/physics/cu_gf_driver_pre.F90 b/physics/cu_gf_driver_pre.F90 index 98cc76b95..6be7b8aec 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/cu_gf_driver_pre.F90 @@ -17,6 +17,7 @@ module cu_gf_driver_pre !! subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, & + rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, & errmsg, errflg) use machine, only: kind_phys @@ -25,6 +26,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, logical, intent(in) :: flag_init logical, intent(in) :: flag_restart + logical, intent(in) :: rrfs_sd integer, intent(in) :: kdt real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: dtp @@ -37,9 +39,11 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(out) :: forceq(:,:) integer, intent(out) :: cactiv(:) integer, intent(out) :: cactiv_m(:) + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm !$acc declare copyout(forcet,forceq,cactiv,cactiv_m) real(kind_phys), intent(in) :: conv_act(:) real(kind_phys), intent(in) :: conv_act_m(:) + real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) !$acc declare copyin(conv_act,conv_act_m) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -79,6 +83,12 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, cactiv_m(:)=nint(conv_act_m(:)) !$acc end kernels + if (rrfs_sd) then + chem3d(:,:,1) = gq0(:,:,ntsmoke) + chem3d(:,:,2) = gq0(:,:,ntdust) + chem3d(:,:,3) = gq0(:,:,ntcoarsepm) + endif + end subroutine cu_gf_driver_pre_run end module cu_gf_driver_pre diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 7fd66d19b..6d8787d06 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -122,6 +122,50 @@ type = real kind = kind_phys intent = in +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer + intent = in +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer + intent = in +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 55427235fbf67a9d55bf5dca5b63e9b5d1f884bd Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Sun, 3 Dec 2023 00:21:15 +0000 Subject: [PATCH 093/122] "update for RRFS-SD code freeze" --- physics/smoke_dust/coarsepm_settling_mod.F90 | 12 +- physics/smoke_dust/dep_data_mod.F90 | 193 +++++ physics/smoke_dust/dep_dry_mod_emerson.F90 | 431 +++++++++++ ...dep_dry_mod.F90 => dep_dry_simple_mod.F90} | 22 +- physics/smoke_dust/dust_fengsha_mod.F90 | 9 +- physics/smoke_dust/module_add_emiss_burn.F90 | 313 +++----- physics/smoke_dust/module_plumerise1.F90 | 33 +- physics/smoke_dust/module_smoke_plumerise.F90 | 14 +- physics/smoke_dust/module_wetdep_ls.F90 | 17 +- physics/smoke_dust/plume_data_mod.F90 | 2 +- physics/smoke_dust/rrfs_smoke_config.F90 | 66 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 3 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 728 +++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 423 +++++----- 14 files changed, 1529 insertions(+), 737 deletions(-) create mode 100755 physics/smoke_dust/dep_data_mod.F90 create mode 100755 physics/smoke_dust/dep_dry_mod_emerson.F90 rename physics/smoke_dust/{dep_dry_mod.F90 => dep_dry_simple_mod.F90} (75%) diff --git a/physics/smoke_dust/coarsepm_settling_mod.F90 b/physics/smoke_dust/coarsepm_settling_mod.F90 index 9061840c3..49f229453 100755 --- a/physics/smoke_dust/coarsepm_settling_mod.F90 +++ b/physics/smoke_dust/coarsepm_settling_mod.F90 @@ -8,7 +8,7 @@ module coarsepm_settling_mod CONTAINS -SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & +SUBROUTINE coarsepm_settling_driver(dt,t_phy, & chem,rho_phy,dz8w,p8w,p_phy,sedim, & area,g,num_chem, & ids,ide, jds,jde, kds,kde, & @@ -24,7 +24,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),INTENT(INOUT ) :: chem REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & - INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy,rel_hum + INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy REAL(kind_phys), DIMENSION( ims:ime , jms:jme ),INTENT(IN ) :: area REAL(kind_phys), INTENT(IN ) :: dt,g @@ -64,7 +64,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & airmas(1,1,kk)=-(p8w(i,k+1,j)-p8w(i,k,j))*area(i,j)/g airden(1,1,kk)=rho_phy(i,k,j) tmp(1,1,kk)=t_phy(i,k,j) - rh(1,1,kk) = rel_hum(i,k,j) ! hli +! rh(1,1,kk) = rel_hum(i,k,j) ! hli do nv = 1, num_chem chem_before(i,j,k,nv) = chem(i,k,j,nv) enddo @@ -82,7 +82,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & call settling(1, 1, lmx, 1,g,dyn_visc, & dust, tmp, p_mid, delz, airmas, & - den_dust, reff_dust, dt, bstl_dust, rh, idust, airden) + den_dust, reff_dust, dt, bstl_dust, idust, airden) kk = 0 do k = kts,kte @@ -111,7 +111,7 @@ END SUBROUTINE coarsepm_settling_driver subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, & tc, tmp, p_mid, delz, airmas, & - den, reff, dt, bstl, rh, idust, airden) + den, reff, dt, bstl, idust, airden) ! **************************************************************************** ! * * ! * Calculate the loss by settling, using an implicit method * @@ -131,7 +131,7 @@ subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, & INTEGER :: ntdt REAL(kind_phys), INTENT(IN) :: dt,g0,dyn_visc REAL(kind_phys), INTENT(IN) :: tmp(imx,jmx,lmx), delz(imx,jmx,lmx), & - airmas(imx,jmx,lmx), rh(imx,jmx,lmx), & + airmas(imx,jmx,lmx), & den(nmx), reff(nmx),p_mid(imx,jmx,lmx),& airden(imx,jmx,lmx) REAL(kind_phys), INTENT(INOUT) :: tc(imx,jmx,lmx,nmx) diff --git a/physics/smoke_dust/dep_data_mod.F90 b/physics/smoke_dust/dep_data_mod.F90 new file mode 100755 index 000000000..bf9ae7f0c --- /dev/null +++ b/physics/smoke_dust/dep_data_mod.F90 @@ -0,0 +1,193 @@ +!>\file dep_data_mod.F90 +!! This file contains data for the dry deposition modules. +module dep_data_mod + + use machine , only : kind_phys + + integer, parameter :: nvegtype = 25 + real(kind_phys), dimension(nvegtype), parameter :: & + kpart = (/500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500. /) + real(kind_phys), parameter :: max_dep_vel = 0.005 ! m/s (may need to set per species) + real(kind_phys), parameter :: dep_ref_hgt = 2.0 ! Meters + real(kind_phys), parameter :: pi = 3.1415926536 +! 3*PI + REAL(kind_phys), PARAMETER :: threepi=3.0*pi + real(kind_phys), parameter :: gravity = 9.81 +! mean gravitational acceleration [ m/sec**2 ] + REAL(kind_phys), PARAMETER :: grav=9.80622 + real(kind_phys), parameter :: boltzmann = 1.3807e-16 +! universal gas constant [ J/mol-K ] + REAL(kind_phys), PARAMETER :: rgasuniv=8.314510 +! Avogadro's Constant [ 1/mol ] + REAL, PARAMETER :: avo=6.0221367E23 + ! Boltzmann's Constant [ J / K ]i\ + REAL(kind_phys), PARAMETER :: boltz=rgasuniv/avo + real(kind_phys), parameter :: Cb = 2., Cim = 0.4, alpha = 0.8, Cin = 2.5, vv = 0.8 + real(kind_phys), parameter :: A_for = 0.1 ! forest + real(kind_phys), parameter :: A_grs = 0.2 ! grass + real(kind_phys), parameter :: A_wat = 100. ! water + real(kind_phys), parameter :: eps0_for = 0.8*0.01 ! forest + real(kind_phys), parameter :: eps0_grs = 0.4*0.01 ! grass + real(kind_phys), parameter :: eps0_wat = 0.6*0.01 ! water + + REAL(kind_phys), PARAMETER :: one3=1.0/3.0 + REAL(kind_phys), PARAMETER :: two3=2.0/3.0 +! SQRT( 2 ) + REAL(kind_phys), PARAMETER :: sqrt2=1.4142135623731 +! SQRT( PI ) + REAL(kind_phys), PARAMETER :: sqrtpi=1.7724539 + REAL(kind_phys) :: karman = 0.4 ! von Karman constant + REAL(kind_phys), PARAMETER :: conmin= 1.E-16 + REAL(kind_phys), PARAMETER :: pirs=3.14159265358979324 + REAL(kind_phys), PARAMETER :: f6dpi=6.0/pirs + REAL(kind_phys), PARAMETER :: f6dpim9=1.0E-9*f6dpi + REAL(kind_phys), PARAMETER :: rhosmoke = 1.4E3 + REAL(kind_phys), PARAMETER :: rhodust = 2.6E3 + REAL(kind_phys), PARAMETER :: smokefac=f6dpim9/rhosmoke + REAL(kind_phys), PARAMETER :: dustfac=f6dpim9/rhodust +! starting standard surface temperature [ K ] + REAL(kind_phys), PARAMETER :: tss0=288.15 + REAL(kind_phys), PARAMETER :: sigma1 = 1.8 + REAL(kind_phys), PARAMETER :: mean_diameter1 = 4.e-8 + REAL(kind_phys), PARAMETER :: fact_wfa = 1.e-9*6.0/pirs*exp(4.5*log(sigma1)**2)/mean_diameter1**3 + REAL(kind_phys), PARAMETER :: sginia=2.00 +! initial sigma-G for nucleimode + REAL(kind_phys), PARAMETER :: sginin=1.70 +! initial sigma-G for coarse mode + REAL(kind_phys), PARAMETER :: sginic=2.5 +! starting standard surface pressure [ Pa ] + REAL(kind_phys), PARAMETER :: pss0=101325.0 +! lowest particle diameter ( m ) + REAL(kind_phys), PARAMETER :: dgmin=1.0E-09 +! lowest particle density ( Kg/m**3 ) + REAL(kind_phys), PARAMETER :: densmin=1.0E03 +! index for Aitken mode number + INTEGER, PARAMETER :: vdnnuc=1 +! index for accumulation mode number + INTEGER, PARAMETER :: vdnacc=2 +! index for coarse mode number + INTEGER, PARAMETER :: vdncor=3 +! index for Aitken mode mass + INTEGER, PARAMETER :: vdmnuc=4 +! index for accumulation mode + INTEGER, PARAMETER :: vdmacc=5 +! index for fine mode mass (Aitken + accumulation) + INTEGER, PARAMETER :: vdmfine=6 +! index for coarse mode mass + INTEGER, PARAMETER :: vdmcor=7 +! index for Aitken mode number + INTEGER, PARAMETER :: vsnnuc=1 +! index for Accumulation mode number + INTEGER, PARAMETER :: vsnacc=2 +! index for coarse mode number + INTEGER, PARAMETER :: vsncor=3 +! index for Aitken mode mass + INTEGER, PARAMETER :: vsmnuc=4 +! index for accumulation mode mass + INTEGER, PARAMETER :: vsmacc=5 +! index for coarse mass + INTEGER, PARAMETER :: vsmcor=6 +! coarse mode exp( log^2( sigmag )/8 ) +! nuclei **4 + REAL(kind_phys) :: esn04 +! accumulation + REAL(kind_phys) :: esa04 + REAL(kind_phys) :: esc04 +! coarse +! nuclei **5 + REAL(kind_phys) :: esn05 + REAL(kind_phys) :: esa05 +! accumulation +! nuclei **8 + REAL(kind_phys) :: esn08 +! accumulation + REAL(kind_phys) :: esa08 + REAL(kind_phys) :: esc08 +! coarse +! nuclei **9 + REAL(kind_phys) :: esn09 + REAL(kind_phys) :: esa09 +! accumulation +! nuclei **12 + REAL(kind_phys) :: esn12 +! accumulation + REAL(kind_phys) :: esa12 + REAL(kind_phys) :: esc12 +! coarse mode +! nuclei **16 + REAL(kind_phys) :: esn16 +! accumulation + REAL(kind_phys) :: esa16 + REAL(kind_phys) :: esc16 +! coarse +! nuclei **20 + REAL(kind_phys) :: esn20 +! accumulation + REAL(kind_phys) :: esa20 + REAL(kind_phys) :: esc20 +! coarse +! nuclei **25 + REAL(kind_phys) :: esn25 + REAL(kind_phys) :: esa25 +! accumulation +! nuclei **24 + REAL(kind_phys) :: esn24 +! accumulation + REAL(kind_phys) :: esa24 + REAL(kind_phys) :: esc24 +! coarse +! nuclei **28 + REAL(kind_phys) :: esn28 +! accumulation + REAL(kind_phys) :: esa28 + REAL(kind_phys) :: esc28 +! coarse +! nuclei **32 + REAL(kind_phys) :: esn32 +! accumulation + REAL(kind_phys) :: esa32 + REAL(kind_phys) :: esc32 +! coarese +! nuclei **36 + REAL(kind_phys) :: esn36 +! accumulation + REAL(kind_phys) :: esa36 + REAL(kind_phys) :: esc36 +! coarse +! nuclei **49 + REAL(kind_phys) :: esn49 + REAL(kind_phys) :: esa49 +! accumulation +! nuclei **52 + REAL(kind_phys) :: esn52 + REAL(kind_phys) :: esa52 +! accumulation +! nuclei **64 + REAL(kind_phys) :: esn64 +! accumulation + REAL(kind_phys) :: esa64 + REAL(kind_phys) :: esc64 +! coarse + REAL(kind_phys) :: esn100 +! nuclei **100 +! nuclei **(-20) + REAL(kind_phys) :: esnm20 +! accumulation + REAL(kind_phys) :: esam20 + REAL(kind_phys) :: escm20 +! coarse +! nuclei **(-32) + REAL(kind_phys) :: esnm32 +! accumulation + REAL(kind_phys) :: esam32 + REAL(kind_phys) :: escm32 +!SAM 10/08 Gaussian quadrature constants for SOA_VBS deposition numerical +!integration + INTEGER, PARAMETER :: NGAUSdv= 7 ! Number of Gaussian Quadrature Points + REAL(kind_phys) :: xxlsgn, xxlsga, xxlsgc + REAL(kind_phys) :: Y_GQ(NGAUSdv), WGAUS(NGAUSdv) +end module dep_data_mod diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 new file mode 100755 index 000000000..d2d34bb4e --- /dev/null +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -0,0 +1,431 @@ +!>\file dep_dry_mod.F90 +!! This file is for the dry depostion driver. +!-------------REVISION HISTORY---------------! +! XX/XX/XXXX : original implementation (Ravan Ahmadov) +! 08/17/2023 : modified to follow Emerson et al., (2020) (Jordan Schnell) +! 08/17/2023 : gravitational settling folowing the coarse pm settling driver (Jordan Schnell) + +module dep_dry_emerson_mod + + use machine , only : kind_phys + use dep_data_mod ! JLS + use rrfs_smoke_config + + implicit none + + private + + public :: dry_dep_driver_emerson + +contains + subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & + chem,delz,snowh,t_phy,p_phy,rho_phy,ivgtyp,g0,dt, & + settling_flag,drydep_flux,settling_flux, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) +! +! compute dry deposition velocity for aerosol particles +! Based on Emerson et al. (2020), PNAS, +! www.pnas.org/cgi/doi/10.1073/pnas.2014761117 +! Code adapted from Hee-Ryu and Min, (2022): +! https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/2021MS002792 +!---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: settling_flag,ndvel, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & + INTENT(INOUT) :: ustar, rmol, znt, snowh + REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & + INTENT(IN ) :: t_phy, rho_phy, p_phy, delz + INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: ivgtyp + REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & + INTENT(INOUT ) :: chem + REAL(kind_phys), INTENT(IN) :: g0,dt + ! + ! Output arrays + REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(INOUT) :: ddvel + REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, ndvel), & + INTENT(OUT) :: vgrav + REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(OUT) :: settling_flux, drydep_flux + ! Local + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) :: aer_res + REAL(kind_phys), DIMENSION( ndvel ) :: cblk + ! Modpar variables, mass, density, diameter, knudsen number, mean free path + REAL(kind_phys) :: pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm + real(kind_phys) :: Cc ! Cunningham/slip correction factor [-] + real(kind_phys) :: DDp, Eb ! Brownian diffusion [] + real(kind_phys) :: Eim ! Impaction [] + real(kind_phys) :: Ein ! Interception [] + real(kind_phys) :: Sc ! Schmit number [] + real(kind_phys) :: St ! Stokes number [] + real(kind_phys) :: vg ! gravitational settling [cm/s] + real(kind_phys) :: A, eps0, dumalnsg ! land surface params [-] + real(kind_phys) :: amu, amu_corrected ! dynamic viscosity [g/s] + real(kind_phys) :: airkinvisc ! Air kinetic viscosity [cm2/s] + real(kind_phys) :: freepath ! Air molecular freepath [cm] + real(kind_phys) :: dp ! aerosol diameter [cm] + real(kind_phys) :: aerodens ! aerosol density [g/cm3] + real(kind_phys) :: Rs ! Surface resistance + real(kind_phys) :: vgpart + real(kind_phys) :: growth_fac,vsettl,dtmax,conver,converi,dzmin + real(kind_phys), dimension( kts:kte) :: rho_col, delz_col + real(kind_phys), dimension(ndvel) :: dt_settl, chem_before, chem_after + real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col + integer, dimension(ndvel) :: ndt_settl + integer :: i, j, k, ntdt, nv + ! chem pointers (p_*) are not sequentially numbered, need to define so nv loops work + integer, dimension(ndvel) :: chem_pointers +!> -- Gas constant + real(kind_phys), parameter :: RSI = 8.314510 + chem_pointers(1) = p_smoke + chem_pointers(2) = p_dust_1 + chem_pointers(3) = p_coarse_pm + + growth_fac = 1.0 + conver=1.e-9 + converi=1.e9 + + do j = jts, jte + do i = its, ite + aer_res(i,j) = 0.0 + do k = kts, kte + delz_col(k) = delz(i,k,j) + rho_col(k) = rho_phy(i,k,j) + do nv = 1, ndvel + cblk(nv) = chem(i,k,j,chem_pointers(nv)) + if ( k == kts ) then + ddvel(i,j,nv) = 0.0 + dt_settl(nv) = 0.0 + endif ! k==kts + end do ! nv + ! *** U.S. Standard Atmosphere 1962 page 14 expression + ! for dynamic viscosity = beta * T * sqrt(T) / ( T + S) + ! where beta = 1.458e-6 [ kg sec^-1 K**-0.5 ], s = 110.4 [ K ]. + amu = 1.458E-6 * t_phy(i,k,j) * sqrt(t_phy(i,k,j)) / ( t_phy(i,k,j) + 110.4 ) + ! Aerodynamic resistance + call depvel( rmol(i,j), dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) + ! depvel uses meters, need to convert to s/cm + aer_res(i,j) = max(aer_res(i,j)/100.,0.) + ! Get the aerosol properties dp and aerodens and mean free path (xlm) + ! FOR RRFS-SD, diameters and densities are explicityly defined + !call modpar( cblk,t_phy(i,k,j),p_phy(i,k,j), amu, & + ! pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & + ! dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm, ndvel ) + ! Air kinematic viscosity (cm^2/s) + airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & + ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 + ! Air molecular freepath (cm) ! Check against XLM from above + freepath = 7.39758e-4 * airkinvisc / sqrt( t_phy(i,k,j) ) + do nv = 1, ndvel + if ( chem_pointers(nv) == p_smoke ) then + dp = 4.E-8 !dgacc + aerodens = 1.4e+3 !pdensa + elseif ( chem_pointers(nv) == p_dust_1) then + dp = 1.E-6 !dgacc + aerodens = 2.6e+3 !pdensa + elseif ( chem_pointers(nv) == p_coarse_pm ) then + dp = 4.5E-6 !dgcor + aerodens = 2.6e+3 !pdensc + else + continue + endif + ! Convert diameter to cm and aerodens to g/cm3 + aerodens = aerodens / 1000. + dp = dp * 1e+2 + ! Cunningham correction factor + Cc = 1. + 2. * freepath / dp * ( 1.257 + 0.4*exp( -0.55 * dp / freepath ) ) + ! Corrected dynamic viscosity (used for settling) + amu_corrected = amu / Cc + ! Gravitational Settling + vg = aerodens * dp * dp * gravity * 100. * Cc / & ! Convert gravity to cm/s^2 + ( 18. * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) ) ! Convert density to mol/cm^3 + ! -- Rest of loop for the surface when deposition velocity needs to be cacluated + if ( k == kts ) then + ! Brownian Diffusion + DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) * dp) ! Convert density to mol/cm^3 + ! Schmit number + Sc = airkinvisc / DDp + ! Brownian Diffusion + Eb = Cb * Sc**(-0.666666667) + ! Stokes number + St = ( 100. * ustar(i,j) ) * ( 100.* ustar(i,j) ) * vg / airkinvisc / ( gravity * 100.) ! Convert ustar to cm/s, gravity to cm/s^2 + ! Impaction + Eim = Cim * ( St / ( alpha + St ) )**1.7 + ! MODIS type lu, large roughness lengths (e.g., urban or forest) + ! ----------------------------------------------------------------------- + ! *** TO DO -- set A and eps0 for all land surface types *** !!! + ! ----------------------------------------------------------------------- + if ( ivgtyp(i,j) .eq. 13 .or. ivgtyp(i,j) .le. 5 ) then ! Forest + A = A_for + eps0 = eps0_for + else if ( ivgtyp(i,j) .eq. 17 ) then ! water + A = A_wat + eps0 = eps0_wat + else ! otherwise + A = A_grs + eps0 = eps0_grs + end if + ! Set if snow greater than 1 cm +! if ( snowh(i,j) .gt. 0.01 ) then ! snow +! A = A_wat +! eps0 = eps0_wat +! endif + ! Interception + Ein = Cin * ( dp / A )**vv + ! Surface resistance + Rs = 1. / ( ( ustar(i,j) * 100.) * ( Eb + Eim + Ein) * eps0 ) ! Convert ustar to cm/s + ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] + ! The /100. term converts from cm/s to m/s, required for MYNN. + ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) + drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & + (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 + endif ! k == kts + vgrav(i,k,j,nv) = vg + ! Fill column variables + cblk_col(k,nv) = cblk(nv) + vg_col(k,nv) = vg + enddo ! nv + enddo ! k + ! -- Get necessary info for settling + ! -- Determine the maximum time-step satisying the CFL condition: + dzmin = minval(delz_col) + ntdt=INT(dt) + do nv = 1, ndvel + ! -- NOTE, diameters and densities are NOT converted to cm and g/cm3 like above + ! -- dt_settl calculations (from original coarsepm_settling) + if ( chem_pointers(nv) == p_smoke ) then + dp = 4.E-8 !dgacc + aerodens = 1.4e+3 !pdensa + elseif ( chem_pointers(nv) == p_dust_1) then + dp = 1.E-6 !dgacc + aerodens = 2.6e+3 !pdensa + elseif ( chem_pointers(nv) == p_coarse_pm ) then + dp = 4.5E-6 !dgcor + aerodens = 2.6e+3 !pdensc + else + continue + endif + ! 1.5E-5 = dyn_visc --> dust_data_mod.F90 + vsettl = 2.0 / 9.0 * g0 * aerodens * ( growth_fac * ( 0.5 * dp ))**2.0 / ( 0.5 * 1.5E-5 ) + dtmax = dzmin / vsettl + ndt_settl(nv) = MAX( 1, INT( ntdt /dtmax) ) + ! Limit maximum number of iterations + IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 + dt_settl(nv) = REAL(ntdt) / REAL(ndt_settl(nv)) + enddo + do nv = 1, ndvel + do k = kts, kte + chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + enddo + enddo + ! Perform gravitational settling if desired + if ( settling_flag == 1 ) then + call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) + endif + ! Put cblk back into chem array + do nv= 1, ndvel + do k = kts, kte + chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) + chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + enddo ! k + settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 + enddo ! nv + end do ! j + end do ! i +end subroutine dry_dep_driver_emerson +! +!-------------------------------------------------------------------------------- +! +subroutine depvel( rmol, zr, z0, ustar, vgpart, aer_res ) +!-------------------------------------------------- +! THIS FUNCTION HAS BEEN DESIGNED TO EVALUATE AN UPPER LIMIT +! FOR THE POLLUTANT DEPOSITION VELOCITY AS A FUNCTION OF THE +! SURFACE ROUGHNESS AND METEOROLOGICAL CONDITIONS. +! PROGRAM WRITTEN BY GREGORY J.MCRAE (NOVEMBER 1977) +! Modified by Darrell A. Winner (Feb. 1991) +! by Winfried Seidl (Aug. 1997) +!.....PROGRAM VARIABLES... +! RMOL - RECIPROCAL OF THE MONIN-OBUKHOV LENGTH +! ZR - REFERENCE HEIGHT +! Z0 - SURFACE ROUGHNESS HEIGHT +! USTAR - FRICTION VELOCITY U* +! AER_RES - AERODYNAMIC RESISTANCE +!.....REFERENCES... +! MCRAE, G.J. ET AL. (1983) MATHEMATICAL MODELING OF PHOTOCHEMICAL +! AIR POLLUTION, ENVIRONMENTAL QUALITY LABORATORY REPORT 18, +! CALIFORNIA INSTITUTE OF TECHNOLOGY, PASADENA, CALIFORNIA. +!.....RESTRICTIONS... +! 1. THE MODEL EDDY DIFFUSIVITIES ARE BASED ON MONIN-OBUKHOV +! SIMILARITY THEORY AND SO ARE ONLY APPLICABLE IN THE +! SURFACE LAYER, A HEIGHT OF O(30M). +! 2. ALL INPUT UNITS MUST BE CONSISTENT +! 3. THE PHI FUNCTIONS USED TO CALCULATE THE FRICTION +! VELOCITY U* AND THE POLLUTANT INTEGRALS ARE BASED +! ON THE WORK OF BUSINGER ET AL.(1971). +! 4. THE MOMENTUM AND POLLUTANT DIFFUSIVITIES ARE NOT +! THE SAME FOR THE CASES L<0 AND L>0. +!-------------------------------------------------- +! .. Scalar Arguments .. +!-------------------------------------------------- + REAL(kind_phys), intent(in) :: ustar, z0, zr + REAL(kind_phys), intent(out) :: vgpart, aer_res + REAL(kind_phys), intent(inout) :: rmol +!-------------------------------------------------- +! .. Local Scalars .. +!-------------------------------------------------- + INTEGER :: l + REAL(kind_phys) :: ao, ar, polint, vk +!-------------------------------------------------- +! .. Intrinsic Functions .. +!-------------------------------------------------- + INTRINSIC alog +!-------------------------------------------------- +! Set the von Karman constant +!-------------------------------------------------- + vk = karman +!-------------------------------------------------- +! DETERMINE THE STABILITY BASED ON THE CONDITIONS +! 1/L < 0 UNSTABLE +! 1/L = 0 NEUTRAL +! 1/L > 0 STABLE +!-------------------------------------------------- + if(abs(rmol) < 1.E-6 ) rmol = 0. + IF (rmol<0) THEN + ar = ((1.0-9.0*zr*rmol)**(0.25)+0.001)**2 + ao = ((1.0-9.0*z0*rmol)**(0.25)+0.001)**2 + polint = 0.74*(alog((ar-1.0)/(ar+1.0))-alog((ao-1.0)/(ao+1.0))) + ELSE IF (rmol==0.) THEN + polint = 0.74*alog(zr/z0) + ELSE + polint = 0.74*alog(zr/z0) + 4.7*rmol*(zr-z0) + END IF + vgpart = ustar*vk/polint + aer_res = polint/(karman*max(ustar,1.0e-4)) +end subroutine depvel +! +!-------------------------------------------------------------------------------- +! +subroutine modpar( cblk, blkta, blkprs, amu, & + pmassn,pmassa,pmassc, pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor, xlm,ndvel ) + IMPLICIT NONE + + INTEGER, INTENT(IN) :: ndvel + REAL(kind_phys), DIMENSION(ndvel), INTENT( IN) :: cblk + REAL(kind_phys), INTENT(IN ) :: blkta, blkprs, amu + REAL(kind_phys), INTENT(OUT) :: pmassn,pmassa,pmassc,pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm +! +! Local + REAL(kind_phys) :: xxlsgn,xxlsga,xxlsgc,l2sginin,l2sginia,l2sginic, & + en1,ea1,ec1,esn04,esa04,esc04, & + esn08,esa08,esc08,esn16,esa16,esc16, & + esn20,esa20,esc20,esn36,esa36,esc36 + REAL(kind_phys), DIMENSION( 6 ) :: nblk ! number densities +! Pointers + INTEGER, PARAMETER :: vnu0 = 1 + INTEGER, PARAMETER :: vac0 = 2 + INTEGER, PARAMETER :: vcorn = 3 + INTEGER, PARAMETER :: vnu3 = 4 + INTEGER, PARAMETER :: vac3 = 5 + INTEGER, PARAMETER :: vcor3 = 6 +! + xxlsgn = log(sginin) + xxlsga = log(sginia) + xxlsgc = log(sginic) + l2sginin = xxlsgn**2 + l2sginia = xxlsga**2 + l2sginic = xxlsgc**2 + en1 = exp(0.125*l2sginin) + ea1 = exp(0.125*l2sginia) + ec1 = exp(0.125*l2sginic) + esn04 = en1**4 + esa04 = ea1**4 + esc04 = ec1**4 + esn08 = esn04*esn04 + esa08 = esa04*esa04 + esc08 = esc04*esc04 + esn16 = esn08*esn08 + esa16 = esa08*esa08 + esc16 = esc08*esc08 + esn20 = esn16*esn04 + esa20 = esa16*esa04 + esc20 = esc16*esc04 + esn36 = esn16*esn20 + esa36 = esa16*esa20 + esc36 = esc16*esc20 +! First step in WRF-Chem is to add together the aitken, accumulation, and coarse modes +! Calculate number densities + nblk(vnu0) = max(conmin,0.0) + nblk(vnu3) = max(conmin,0.0) + nblk(vac0) = max(conmin, (cblk(1)/rhosmoke + cblk(2)/rhodust)*fact_wfa) + nblk(vcorn) = max(conmin, cblk(3)/rhodust*fact_wfa) + nblk(vac3) = max(conmin,smokefac*cblk(2) + dustfac*cblk(1)) ! Accumulation is smoke + fine dust + nblk(vcor3) = max(conmin,dustfac*cblk(3)) +! Dust in coarse + pmassn = max(conmin,0.0) + pmassa = max(conmin,cblk(1) + cblk(2)) + pmassc = max(conmin,cblk(3)) + pdensn = max(conmin,0.0) + pdensa = max(densmin,(f6dpim9*pmassa/nblk(vac3))) + pdensc = max(densmin,(f6dpim9*pmassc/nblk(vcor3))) +! Calculate mean free path + xlm = 6.6328E-8*pss0*blkta/(tss0*blkprs*1.e3) +! Calculate diameters + dgnuc = max(dgmin,0.0) + dgacc = max(dgmin,(nblk(vac3)/(nblk(vac0)*esa36))**one3) + dgcor = max(dgmin,(nblk(vcor3)/(nblk(vcorn)*esc36))**one3) +! Calculate Knudsen numbers + knnuc = 2.0*xlm/dgnuc + knacc = 2.0*xlm/dgacc + kncor = 2.0*xlm/dgcor +end subroutine modpar +! +!-------------------------------------------------------------------------------- +! +subroutine particle_settling(cblk,rho_phy,delz,vg,dt_settl,ndt_settl,ndvel,kts,kte) + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: kts, kte, ndvel + REAL(kind_phys), DIMENSION(kts:kte), INTENT (IN) :: rho_phy, delz + REAL(kind_phys), DIMENSION(kts:kte,ndvel), INTENT(IN) :: vg + REAL(kind_phys), DIMENSION(kts:kte,ndvel), INTENT(INOUT) :: cblk + REAL(kind_phys), DIMENSION(ndvel), INTENT(IN) :: dt_settl + INTEGER, DIMENSION(ndvel), INTENT(IN) :: ndt_settl +! +!--- Local------ + INTEGER :: k,nv,n,l2 + REAL(kind_phys) :: temp_tc, transfer_to_below_level, vd_wrk1 + REAL(kind_phys), DIMENSION(kts:kte) :: delz_flip + + do k = kts,kte + delz_flip(k) = delz(kte-k+kts) + enddo + + do nv = 1, ndvel + do n = 1,ndt_settl(nv) + transfer_to_below_level = 0.0 + do k = kte,kts,-1 + l2 = kte - k + 1 + + temp_tc = cblk(k,nv) + + vd_wrk1 = dt_settl(nv) * vg(k,nv)/100. / delz_flip(l2) ! convert vg to m/s + + cblk(k,nv)= cblk(k,nv) * (1. - vd_wrk1) + transfer_to_below_level + if (k.gt.kts) then + transfer_to_below_level =(temp_tc*vd_wrk1)*((delz_flip(l2) & + *rho_phy(k))/(delz_flip(l2+1)*rho_phy(k-1))) ! [ug/kg] + endif + enddo ! k + enddo ! n + enddo ! nv +end subroutine particle_settling + +! +end module dep_dry_emerson_mod diff --git a/physics/smoke_dust/dep_dry_mod.F90 b/physics/smoke_dust/dep_dry_simple_mod.F90 similarity index 75% rename from physics/smoke_dust/dep_dry_mod.F90 rename to physics/smoke_dust/dep_dry_simple_mod.F90 index ea7dd9963..91e2997c5 100755 --- a/physics/smoke_dust/dep_dry_mod.F90 +++ b/physics/smoke_dust/dep_dry_simple_mod.F90 @@ -1,7 +1,7 @@ -!>\file dep_dry_mod.F90 +!>\file dep_dry_simple_mod.F90 !! This file is for the dry depostion driver. -module dep_dry_mod +module dep_dry_simple_mod use machine , only : kind_phys @@ -9,11 +9,11 @@ module dep_dry_mod private - public :: dry_dep_driver + public :: dry_dep_driver_simple contains - subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & + subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -26,8 +26,8 @@ subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(INOUT) :: ust, rmol - REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & - INTENT(IN ) :: rel_hum +! REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & +! INTENT(IN ) :: rel_hum REAL(kind_phys), PARAMETER :: kpart=500. REAL(kind_phys) :: dvpart @@ -56,14 +56,14 @@ subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & dvpart = dvpart*(1.+(-300.*rmol(i,j))**0.66667) ENDIF - IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION - dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) - END IF +! IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION +! dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) +! END IF ddvel(i,j,nv) = MIN(0.50,dvpart) ! m/s enddo enddo enddo -end subroutine dry_dep_driver +end subroutine dry_dep_driver_simple -end module dep_dry_mod +end module dep_dry_simple_mod diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 1e24c8947..3902d6508 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -22,7 +22,7 @@ module dust_fengsha_mod subroutine gocart_dust_fengsha_driver(dt, & chem,rho_phy,smois,p8w,ssm, & - isltyp,vegfra,snowh,xland,area,g,emis_dust, & + isltyp,snowh,xland,area,g,emis_dust, & ust,znt,clay,sand,rdrag,uthr, & num_emis_dust,num_chem,num_soil_layers, & ids,ide, jds,jde, kds,kde, & @@ -37,7 +37,6 @@ subroutine gocart_dust_fengsha_driver(dt, & ! 2d input variables REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: ssm ! Sediment supply map - REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: vegfra ! vegetative fraction (-) REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: snowh ! snow height (m) REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: xland ! dominant land use type REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: area ! area of grid cell @@ -141,9 +140,9 @@ subroutine gocart_dust_fengsha_driver(dt, & endif ! limit where there is lots of vegetation - if (vegfra(i,j) .gt. .17) then - ilwi = 0 - endif + !if (sum(vegfra(i,:,j)) .gt. .17) then + ! ilwi = 0 + !endif ! limit where there is snow on the ground if (snowh(i,j) .gt. 0) then diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 6cdd2e071..70c14c54c 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -6,23 +6,16 @@ module module_add_emiss_burn use machine , only : kind_phys use rrfs_smoke_config CONTAINS - subroutine add_emis_burn(dtstep,dz8w,rho_phy,rel_hum, & - chem,julday,gmt,xlat,xlong, & - !luf_igbp,lu_fire1, & - vegtype,vfrac,peak_hr, & - time_int,ebu, & ! RAR - r_q,fhist,ext3d_smoke,ext3d_dust, & - ! nwfa,nifa, & - rainc,rainnc, swdown,smoke_forecast, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -! USE module_configure, only: grid_config_rec_type -! USE module_state_description - IMPLICIT NONE + subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & + chem,julday,gmt,xlat,xlong, & + fire_end_hr, peak_hr,time_int, & + coef_bb_dc, fhist, hwp, hwp_prevd, & + swdown,ebb_dcycle, ebu_in, ebu,fire_type,& + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) -! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + IMPLICIT NONE INTEGER, INTENT(IN ) :: julday, & ids,ide, jds,jde, kds,kde, & @@ -30,193 +23,135 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,rel_hum, & its,ite, jts,jte, kts,kte real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & - INTENT(INOUT ) :: chem + INTENT(INOUT ) :: chem ! shall we set num_chem=1 here? real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), & - INTENT(IN) :: ebu - - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, rainc,rainnc,swdown, peak_hr, vfrac - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: r_q ! RAR: - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist ! RAR: - real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(OUT) :: ext3d_smoke, ext3d_dust ! RAR: - integer, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: vegtype - - real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN) :: dz8w,rho_phy,rel_hum -! real(kind_phys), DIMENSION(ims:ime,1:nlcat,jms:jme), INTENT(IN) :: luf_igbp - -! real(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & -! OPTIONAL, INTENT(INOUT ) :: nwfa,nifa ! RAR: - - real(kind_phys), INTENT(IN) :: dtstep, gmt - real(kind_phys), INTENT(IN) :: time_int ! RAR: time in seconds since start of simulation - integer, INTENT(IN) :: smoke_forecast - - integer :: i,j,k,n,m - real(kind_phys) :: conv_rho, conv, ext2, dm_smoke, daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 - !real(kind_phys) :: ebumax -! CHARACTER (LEN=80) :: message - - INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - ! Diameters and standard deviations for emissions - ! the diameters are the volume (mass) geometric mean diameters, following MADE_SORGAM - real(kind_phys), PARAMETER :: dgvem_i= 0.08E-6 !0.03E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_i = 1.8 !1.7 - - ! *** Accumulation mode: - real(kind_phys), PARAMETER :: dgvem_j= 0.3E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_j = 2.0 - - ! *** Coarse mode - real(kind_phys), PARAMETER :: dgvem_c= 6.0E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_c= 2.2 - real(kind_phys), PARAMETER :: pic= 3.14159 - - ! RAR: factors for getting number emissions rate from mass emissions rate following made_sorgam - real(kind_phys), PARAMETER :: fact_numn= 1.e-9*6.0/pic*exp(4.5*log(sgem_i)**2)/dgvem_i**3 ! Aitken mode - real(kind_phys), PARAMETER :: fact_numa= 1.e-9*6.0/pic*exp(4.5*log(sgem_j)**2)/dgvem_j**3 ! accumulation mode - real(kind_phys), PARAMETER :: fact_numc= 1.e-9*6.0/pic*exp(4.5*log(sgem_c)**2)/dgvem_c**3 ! coarse mode - - real(kind_phys), PARAMETER :: dens_oc_aer=1.4e3, dens_ec_aer=1.7e3 ! kg/m3 -! real(kind_phys), PARAMETER :: rinti=2.1813936e-8, cx=2.184936* 3600, timeq_max=3600.*24. ! constants for the diurnal cycle calculations - real(kind_phys), PARAMETER :: ax1=531., cx1=7800. ! For cropland, urban and small fires -! real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3200., const2=100., coef2=10.6712963e-4, cx=2.184936* 3600, timeq_max=3600.*24. - real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. ! New parameters - real(kind_phys), PARAMETER :: sc_me= 4.0, ab_me=0.5 ! m2/g, scattering and absorption efficiency for smoke - -! Parameters used for the wfa and ifa in mp physics per Trude E. (NCAR) -! Water friendly: radius: 0.04 micron, standard deviation: 1.8, kappa (for hygroscopic growth): 0.2, real index of refraction: 1.53, imaginary index of refraction: 1e-7 -! Ice friendly: radius: 0.4 micron, standard deviation: 1.8, kappa : 0.04, real index of refraction: 1.56, imaginary index of refraction: 3e-3 + INTENT(INOUT ) :: ebu + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, swdown + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !, vfrac + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: coef_bb_dc ! RAR: + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp_prevd + + real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN) :: dz8w,rho_phy !,rel_hum + real(kind_phys), INTENT(IN) :: dtstep, gmt + real(kind_phys), INTENT(IN) :: time_int,pi ! RAR: time in seconds since start of simulation + INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: fire_type + integer, INTENT(IN) :: ebb_dcycle ! RAR: this is going to be namelist dependent, ebb_dcycle=means + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist +!>--local + integer :: i,j,k,n,m + real(kind_phys) :: conv_rho, conv, dm_smoke, dc_hwp, dc_gp, dc_fn !daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 + + INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise + ! real, parameter :: cx = 2.184936 * 3600., rinti = 2.1813936e-8 , ax = 2000.6038 ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. - real(kind_phys) :: timeq, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + ! For Gaussian diurnal cycle + REAL, PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later + REAL, PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & + coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. +!>-- Fire parameters + real(kind=kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) + real(kind=kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) timeq= gmt*3600. + real(time_int,4) timeq= mod(timeq,timeq_max) -! Main loops to add BB emissions - do j=jts,jte - do i=its,ite - !if( luf_igbp(i,17,j)>0.99 .OR. ebu(i,1,j,p_ebu_smoke) < 1.e-6) cycle ! no BB emissions or water pixels - if( (1.-vfrac (i,j))>0.99 .OR. ebu(i,1,j) < 1.e-6) cycle ! no BB emissions or water pixels - - ! RAR: the decrease in the BB emissions after >18 hrs of forecast, the decrease occurs at night. The decrease occurs at night. - IF (time_int>64800. .AND. swdown(i,j)<.1 .AND. fhist(i,j)>.75 ) THEN - fhist(i,j)= 0.75 - ENDIF - - IF (time_int>129600. .AND. swdown(i,j)<.1 .AND. fhist(i,j)>.5 ) THEN ! After 36 hr forecast - fhist(i,j)= 0.5 - ENDIF - IF ( (rainc(i,j) + rainnc(i,j))>=10. .AND. fhist(i,j)>.3 ) THEN ! If it rains more than 1cm, then the BB emissions are reduced - fhist(i,j)= 0.3 - ENDIF - -! RAR: Grasslands (29% of ther western HRRR CONUS domain) probably also need to be added below, check this later -! RAR: In the HRRR CONUS domain (western part) crop 11%, 2% cropland/natural vegetation and 0.4% urban of pixels -!.OR. lu_index(i,j)==14) then ! Croplands(12), Urban and Built-Up(13), cropland/natural vegetation (14) mosaic in MODI-RUC vegetation classes +! RAR: Grasslands (29% of ther western HRRR CONUS domain) probably also need to +! be added below, check this later +! RAR: In the HRRR CONUS domain (western part) crop 11%, 2% cropland/natural +! vegetation and 0.4% urban of pixels +!.OR. lu_index(i,j)==14) then ! Croplands(12), Urban and Built-Up(13), +!cropland/natural vegetation (14) mosaic in MODI-RUC vegetation classes ! Peak hours for the fire activity depending on the latitude -! if (xlong(i,j)<-130.) then max_ti= 24.041288* 3600. ! peak at 24 UTC, fires in Alaska -! elseif (xlong(i,j)<-100.) then max_ti= 22.041288* 3600. ! peak at 22 UTC, fires in the western US -! elseif (xlong(i,j)<-70.) then ! peak at 20 UTC, fires in the eastern US, max_ti= 20.041288* 3600. +! if (xlong(i,j)<-130.) then max_ti= 24.041288* 3600. ! +! peak at 24 UTC, fires in Alaska +! elseif (xlong(i,j)<-100.) then max_ti= 22.041288* 3600. +! ! peak at 22 UTC, fires in the western US +! elseif (xlong(i,j)<-70.) then ! peak at 20 UTC, fires in +! the eastern US, max_ti= 20.041288* 3600. ! else max_ti= 18.041288* 3600. ! endif - - !IF ( lu_fire1(i,j)>0.9 ) then !Ag, urban fires, bare land etc. - IF ( vegtype(i,j)==12 .or. vegtype(i,j)==13 ) then !Ag, urban fires, bare land etc. - ! these fires will have exponentially decreasing diurnal cycle, these fires decrease 55% in 2 hours, end in 5 hours - r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) - ELSE - ! RAR: Gaussian profile for wildfires - dt1= abs(timeq - peak_hr(i,j)) - dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. - dtm= MIN(dt1,dt2) - r_q(i,j) = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) - ENDIF - - r_q(i,j) = fhist(i,j)* max(0.,r_q(i,j)*timeq_max) - - !IF (swdown(i,j)<.1) THEN - ! r_q(i,j)= MIN(0.5,r_q(i,j)) ! lower BB emissions at night - !ENDIF - - !IF (.NOT. config_flags%bb_dcycle) THEN - !IF (.NOT. bb_dcycle) THEN - ! r_q(i,j)= fhist(i,j) ! no diurnal cycle - !END IF - - !IF (smoke_forecast == 0) THEN - r_q(i,j)= 1. - !END IF - - do k=kts,kfire_max - conv= r_q(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) - - ! RAR: in this case tracer_1 is fire emitted CO - ! conv_rho=r_q*4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.) - ! chem(i,k,j,p_tracer_1) = chem(i,k,j,p_tracer_1) + ebu(i,k,j,p_ebu_co)*conv_rho - -! dm_oc_bb = conv* ebu(i,k,j,p_ebu_oc) ! Assume that BB primary PM25 is mostly OC, 1.25 is OM/OC ratio -! dm_p25_bb= conv* ebu(i,k,j,p_ebu_pm25) -! dm_ec_bb = conv* ebu(i,k,j,p_ebu_bc) -! dm_smk = conv* ebu(i,k,j,p_ebu_smoke) - !IF (k==kts) THEN ! Partition takes place here to avoid double counting of smold. and flam. BB emiss. - ! C11= (1.-flam_frac(i,j))*r_q(i,j) - !ELSE - ! C11= flam_frac(i,j)*r_q(i,j) - !ENDIF - dm_smoke= conv*ebu(i,k,j) -! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) - - chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) - - ! if ( k==kts ) then - ! WRITE(6,*) 'add_emiss_burn: gmt,dtstep,time_int ',gmt,dtstep,time_int - ! WRITE(*,*) 'add_emiss_burn: i,j,xlat(i,j),xlong(i,j) ',i,j,xlat(i,j),xlong(i,j) - !WRITE(*,*) 'add_emiss_burn: luf_igbp(i,:,j) ',luf_igbp(i,:,j) - !WRITE(*,*) 'add_emiss_burn: lu_fire1(i,j) ',lu_fire1(i,j) - ! WRITE(6,*) 'add_emiss_burn: timeq,peak_hr(i,j),fhist(i,j),r_q(i,j) ',timeq,peak_hr(i,j),fhist(i,j),r_q(i,j) - ! WRITE(*,*) 'add_emiss_burn: rainc(i,j),rainnc(i,j) ', rainc(i,j),rainnc(i,j) - ! endif - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif - - enddo - enddo - enddo - - ext2= sc_me + ab_me - do j=jts,jte - do k=kts,kte - do i=its,ite - - ! Check for NaNs, negative and too large numbers - IF (.NOT. (chem(i,k,j,p_smoke)>=0. .AND. chem(i,k,j,p_smoke)<1.1e+4)) THEN - chem(i,k,j,p_smoke)=1.e-16 - END IF - - ext3d_smoke(i,k,j)= 1.e-6* ext2* chem(i,k,j,p_smoke )*rho_phy(i,k,j)*dz8w(i,k,j) - ext3d_dust (i,k,j)= 1.e-6* ext2* chem(i,k,j,p_dust_1)*rho_phy(i,k,j)*dz8w(i,k,j) - enddo - enddo - enddo - - IF ( dbg_opt ) then - WRITE(*,*) 'add_emis_burn: i,j,k,ext2 ',i,j,k,ext2 - WRITE(*,*) 'add_emis_burn: rel_hum(its,kts,jts),rel_hum(ite,kfire_max,jte) ',rel_hum(its,kts,jts),rel_hum(ite,kfire_max,jte) - WRITE(*,*) 'add_emis_burn: ext3d_smoke(its,kts,jts),ext3d_smoke(ite,kfire_max,jte) ',ext3d_smoke(its,kts,jts),ext3d_smoke(ite,kfire_max,jte) - WRITE(*,*) 'add_emis_burn: ext3d_dust(its,kts,jts),ext3d_dust(ite,kfire_max,jte) ',ext3d_dust(its,kts,jts),ext3d_dust(ite,kfire_max,jte) - END IF - -! CASE DEFAULT -! call wrf_debug(15,'nothing done with burn emissions for chem array') -! END SELECT emiss_select +! RAR: for option #1 ebb and frp are ingested for 24 hours. No modification is +! applied! + if (ebb_dcycle==1) then + do k=kts,kte + do i=its,ite + ebu(i,k,1)=ebu_in(i,1) ! RAR: + enddo + enddo + endif + + if (ebb_dcycle==2) then + + ! Constants for the fire diurnal cycle calculation + do j=jts,jte + do i=its,ite + fire_age= time_int + (fire_end_hr(i,j))*3600. + + SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. + CASE (1) + ! these fires will have exponentially decreasing diurnal cycle, + ! these fires decrease 55% in 2 hours, end in 5 hours + ! r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) + ! We assume 1hr latency in ingesting the sat. data + coef_bb_dc(i,j) = 1./((2*pi)**0.5 * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) + CASE (3) + age_hr= fire_age/3600. + + IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN + fhist(i,j)= 0.75 + ENDIF + IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN + fhist(i,j)= 0.5 + ENDIF + IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN + fhist(i,j)= 0.25 + ENDIF + + ! this is based on hwp, hourly or instantenous TBD + dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1.,hwp_prevd(i,j)) + dc_hwp= MAX(0.,dc_hwp) + + !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( + !hwp_(i,j)/ hwp_day_avg(i,j))) + + ! RAR: Gaussian profile for wildfires + dt1= abs(timeq - peak_hr(i,j)) + dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. + dtm= MIN(dt1,dt2) + dc_gp = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) + dc_gp = MAX(0.,dc_gp) + + dc_fn = MAX(dc_hwp/dc_gp,3.) + coef_bb_dc(i,j) = sc_factor* fhist(i,j)* dc_fn + + do k=kts,kfire_max + conv= coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + + dm_smoke= conv*ebu(i,k,j) + ! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) + + chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke + chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then + WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k + WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv + WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke + endif + enddo + CASE DEFAULT + END SELECT + enddo + enddo + endif END subroutine add_emis_burn END module module_add_emiss_burn + diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 3c23faa6a..f98350130 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -34,11 +34,12 @@ module module_plumerise1 ! 'aggr' /) ! grassland CONTAINS -subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & +subroutine ebu_driver ( flam_frac,ebu_in,ebu,coef_bb_dc, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - plume_frp, k_min, k_max, & ! RAR: + frp_hr, k_min, k_max, & ! RAR: + wind_eff_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg) @@ -51,7 +52,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to have plume rise - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme, 2 ), INTENT(IN ) :: plume_frp ! RAR: FRP etc. array + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_hr ! RAR: FRP array ! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags character(*), intent(inout) :: errmsg @@ -59,13 +60,15 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN ) :: wind_eff_opt ! real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), & ! INTENT(IN ) :: moist real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu - + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: coef_bb_dc ! RAR: real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ) :: frp_hr_coef_bb_dc ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -130,12 +133,19 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & enddo !enddo +! Apply the diurnal cycle coefficient + do j=jts,jte + do i=its,ite + frp_hr_coef_bb_dc(i,j) = frp_hr(i,j)*coef_bb_dc(i,j) + enddo + enddo + ! For now the flammable fraction is constant, based on the namelist. The next ! step to use LU index and meteorology to parameterize it do j=jts,jte do i=its,ite flam_frac(i,j)= 0. - if (plume_frp(i,j,1) > frp_threshold) then + if (frp_hr_coef_bb_dc(i,j) > frp_threshold) then flam_frac(i,j)= 0.9 end if enddo @@ -171,7 +181,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & IF (dbg_opt) then WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: plume_frp(i,j,:) ',plume_frp(i,j,:) + WRITE(*,*) 'module_plumerise1: frp_hr(i,j) ',frp_hr_coef_bb_dc(i,j) WRITE(*,*) 'module_plumerise1: ebu(i,kts,j) ',ebu(i,kts,j) WRITE(*,*) 'module_plumerise1: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) WRITE(*,*) 'module_plumerise1: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) @@ -179,12 +189,13 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & END IF ! RAR: the plume rise calculation step: - CALL plumerise(kte,1,1,1,1,1,1, & + CALL plumerise(kte,1,1,1,1,1,1, & !firesize,mean_fct, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & - plume_frp(i,j,1), k_min(i,j), & + wind_eff_opt, & + frp_hr_coef_bb_dc(i,j), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) !k_max(i,j), config_flags%debug_chem ) @@ -195,9 +206,9 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) do k=kp1,kp2-1 - ebu(i,k,j)= flam_frac(i,j)* ebb_smoke(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume enddo - ebu(i,kts,j)= (1.-flam_frac(i,j))* ebb_smoke(i,j) + ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) IF ( dbg_opt ) then WRITE(*,*) 'module_plumerise1: i,j ',i,j diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 61be06181..d80eaeb62 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -14,9 +14,9 @@ module module_smoke_plumerise use machine , only : kind_phys - use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std, & + use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std !tropical_forest, boreal_forest, savannah, grassland, & - wind_eff + ! wind_eff USE module_zero_plumegen_coms !real(kind=kind_phys),parameter :: rgas=r_d @@ -24,16 +24,18 @@ module module_smoke_plumerise CONTAINS ! RAR: - subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & + subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & + wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) implicit none LOGICAL, INTENT (IN) :: dbg_opt + INTEGER, INTENT (IN) :: wind_eff_opt ! INTEGER, PARAMETER :: ihr_frp=1, istd_frp=2!, imean_fsize=3, istd_fsize=4 ! RAR: @@ -43,6 +45,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies + INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -68,10 +71,13 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! integer, parameter :: grassland = 4 ! real(kind=kind_phys), dimension(nveg_agreg) :: firesize,mean_fct - INTEGER, PARAMETER :: wind_eff = 1 + INTEGER :: wind_eff type(plumegen_coms), pointer :: coms +! Set wind effect from namelist + wind_eff = wind_eff_opt + ! integer:: iloop !REAL(kind=kind_phys), INTENT (IN) :: convert_smold_to_flam diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index 87212920b..b9d52cb49 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -3,17 +3,18 @@ module module_wetdep_ls use machine , only : kind_phys - use rrfs_smoke_config, only : p_qc, alpha => wetdep_ls_alpha + use rrfs_smoke_config, only : p_smoke, p_dust_1, p_coarse_pm, p_qc, alpha => wetdep_ls_alpha contains subroutine wetdep_ls(dt,var,rain,moist, & - rho,nchem,num_moist,dz8w,vvel, & + rho,nchem,num_moist,ndvel,dz8w,vvel, & + wetdpr_smoke, wetdpr_dust, wetdpr_coarsepm, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) implicit none - integer, intent(in) :: nchem, num_moist, & + integer, intent(in) :: nchem, num_moist, ndvel, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte @@ -21,6 +22,8 @@ subroutine wetdep_ls(dt,var,rain,moist, real(kind_phys), dimension( ims:ime, kms:kme, jms:jme, num_moist),intent(in) :: moist real(kind_phys), dimension( ims:ime, kms:kme, jms:jme),intent(in) :: rho,dz8w,vvel real(kind_phys), dimension( ims:ime, kms:kme, jms:jme,1:nchem),intent(inout) :: var + real(kind_phys), dimension( ims:ime, jms:jme ), intent(out) :: & + wetdpr_smoke, wetdpr_dust, wetdpr_coarsepm real(kind_phys), dimension( ims:ime, jms:jme),intent(in) :: rain real(kind_phys), dimension( its:ite, jts:jte) :: var_sum,var_rmv real(kind_phys), dimension( its:ite, kts:kte, jts:jte) :: var_rmvl @@ -68,6 +71,14 @@ subroutine wetdep_ls(dt,var,rain,moist, if(var(i,k,j,nv).gt.1.e-16 .and. moist(i,k,j,p_qc).gt.0.)then factor = max(0.,frc(i,j)*rho(i,k,j)*dz8w(i,k,j)*vvel(i,k,j)) dvar=alpha*factor/(1+factor)*var(i,k,j,nv) +! Accumulate diags + if (nv .eq. p_smoke ) then + wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + elseif (nv .eq. p_dust_1 ) then + wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + elseif (nv .eq. p_coarse_pm ) then + wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + endif var(i,k,j,nv)=max(1.e-16,var(i,k,j,nv)-dvar) endif enddo diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 index 3d4b21c37..2bf91dbfa 100755 --- a/physics/smoke_dust/plume_data_mod.F90 +++ b/physics/smoke_dust/plume_data_mod.F90 @@ -45,7 +45,7 @@ module plume_data_mod integer, parameter :: savannah = 3 integer, parameter :: grassland = 4 integer, parameter :: nveg_agreg = 4 - integer, parameter :: wind_eff = 1 +! integer, parameter :: wind_eff = 1 public diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index 58d4c5846..5f8f02e7b 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -15,28 +15,30 @@ module rrfs_smoke_config !-- constant paramters real(kind=kind_phys), parameter :: epsilc = 1.e-12 - !-- aerosol module configurations - integer :: chem_opt = 1 + integer :: chem_opt = 1 integer :: kemit = 1 integer :: dust_opt = 5 - integer :: seas_opt = 2 + integer :: seas_opt = 0 ! turn off by default logical :: do_plumerise = .true. integer :: addsmoke_flag = 1 + integer :: smoke_forecast = 1 integer :: plumerisefire_frq=60 integer :: wetdep_ls_opt = 1 integer :: drydep_opt = 1 - integer :: coarsepm_settling = 1 - logical :: bb_dcycle = .false. - logical :: aero_ind_fdb = .false. + integer :: pm_settling = 1 + integer :: nfire_types = 5 + integer :: ebb_dcycle = 2 ! 1: read in ebb_smoke(i,24), 2: daily logical :: dbg_opt = .true. - integer :: smoke_forecast = 0 ! 0 read in ebb_smoke(i,24) + logical :: aero_ind_fdb = .false. + logical :: do_rrfs_sd = .true. +! integer :: wind_eff_opt = 1 + logical :: extended_sd_diags = .false. real(kind_phys) :: wetdep_ls_alpha = .5 ! scavenging factor ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: call_chemistry = 1 - integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 integer, parameter :: DUST_OPT_FENGSHA = 5 @@ -52,41 +54,19 @@ module rrfs_smoke_config integer :: numgas = 0 !-- tracers - integer, parameter :: p_so2=1 - integer, parameter :: p_sulf=2 - integer, parameter :: p_dms=3 - integer, parameter :: p_msa=4 - integer, parameter :: p_p25=5, p_smoke=5 - integer, parameter :: p_bc1=6 - integer, parameter :: p_bc2=7 - integer, parameter :: p_oc1=8 - integer, parameter :: p_oc2=9 - integer, parameter :: p_dust_1=10 - integer, parameter :: p_dust_2=11 - integer, parameter :: p_dust_3=12 - integer, parameter :: p_dust_4=13 - integer, parameter :: p_dust_5=14, p_coarse_pm=14 - integer, parameter :: p_seas_1=15 - integer, parameter :: p_seas_2=16 - integer, parameter :: p_seas_3=17 - integer, parameter :: p_seas_4=18 - integer, parameter :: p_seas_5=19 - integer, parameter :: p_p10 =20 - - integer, parameter :: p_edust1=1,p_edust2=2,p_edust3=3,p_edust4=4,p_edust5=5 - integer, parameter :: p_eseas1=1,p_eseas2=2,p_eseas3=3,p_eseas4=4,p_eseas5=5 - - integer :: p_ho=0,p_h2o2=0,p_no3=0 + integer, parameter :: p_smoke=5 + integer, parameter :: p_dust_1=10 + integer, parameter :: p_dust_2=11 + integer, parameter :: p_dust_3=12 + integer, parameter :: p_dust_4=13 + integer, parameter :: p_dust_5=14, p_coarse_pm=14 + integer, parameter :: p_seas_1=15 + integer, parameter :: p_seas_2=16 + integer, parameter :: p_seas_3=17 + integer, parameter :: p_seas_4=18 + integer, parameter :: p_seas_5=19 - ! constants - real(kind=kind_phys), PARAMETER :: airmw = 28.97 - real(kind=kind_phys), PARAMETER :: mw_so2_aer = 64.066 - real(kind=kind_phys), PARAMETER :: mw_so4_aer = 96.066 - real(kind=kind_phys), parameter :: smw = 32.00 - real(kind=kind_phys), parameter :: mwdry = 28. -! d is the molecular weight of dry air (28.966), w/d = 0.62197, and -! (d - w)/d = 0.37803 -! http://atmos.nmsu.edu/education_and_outreach/encyclopedia/humidity.htm + integer, parameter :: p_edust1=1,p_edust2=2,p_edust3=3,p_edust4=4,p_edust5=5 ! -- fire options ! integer, parameter :: num_plume_data = 1 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50f7afae7..5f8ca2a8e 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90 - + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index c9a6344b8..f4e28be3a 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -7,17 +7,18 @@ module rrfs_smoke_wrapper use machine , only : kind_phys use rrfs_smoke_config, only : kemit, dust_opt, seas_opt, do_plumerise, & addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & - drydep_opt, coarsepm_settling, aero_ind_fdb, & - dbg_opt, smoke_forecast, wetdep_ls_alpha, & + drydep_opt, pm_settling, aero_ind_fdb, ebb_dcycle, & + dbg_opt,smoke_forecast,wetdep_ls_alpha,do_rrfs_sd, & + ebb_dcycle, extended_sd_diags, & num_moist, num_chem, num_emis_seas, num_emis_dust, & DUST_OPT_FENGSHA, p_qv, p_atm_shum, p_atm_cldq, & p_smoke, p_dust_1, p_coarse_pm, epsilc - use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & + use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor - use plume_data_mod, only : p_frp_std, p_frp_hr, num_frp_plume use seas_mod, only : gocart_seasalt_driver use dust_fengsha_mod, only : gocart_dust_fengsha_driver - use dep_dry_mod, only : dry_dep_driver + use dep_dry_simple_mod, only : dry_dep_driver_simple + use dep_dry_emerson_mod, only : dry_dep_driver_emerson use module_wetdep_ls, only : wetdep_ls use module_plumerise1, only : ebu_driver use module_add_emiss_burn, only : add_emis_burn @@ -27,13 +28,80 @@ module rrfs_smoke_wrapper private - public :: rrfs_smoke_wrapper_run + public :: rrfs_smoke_wrapper_run, rrfs_smoke_wrapper_init + + integer :: wind_eff_opt contains !>\defgroup rrfs_smoke_wrapper rrfs-sd emission driver Module !> \ingroup gsd_chem_group !! This is the rrfs-sd emission driver Module + +!> \section arg_table_rrfs_smoke_wrapper_init Argument Table +!! \htmlinclude rrfs_smoke_wrapper_init.html +!! + subroutine rrfs_smoke_wrapper_init( seas_opt_in, & ! sea salt namelist + drydep_opt_in, pm_settling_in, & ! Dry Dep namelist + wetdep_ls_opt_in,wetdep_ls_alpha_in, & ! Wet dep namelist + rrfs_sd, do_plumerise_in, plumerisefire_frq_in, & ! smoke namelist + wind_eff_opt_in, & ! smoke namelist + addsmoke_flag_in, ebb_dcycle_in, smoke_forecast_in, & ! Smoke namelist + dust_opt_in, dust_alpha_in, dust_gamma_in, & ! Dust namelist + dust_moist_opt_in, & ! Dust namelist + dust_moist_correction_in, dust_drylimit_factor_in, & ! Dust namelist + aero_ind_fdb_in, & ! Feedback namelist + extended_sd_diags_in,dbg_opt_in, & ! Other namelist + errmsg, errflg ) + + +!>-- Namelist + real(kind_phys), intent(in) :: dust_alpha_in, dust_gamma_in, wetdep_ls_alpha_in + real(kind_phys), intent(in) :: dust_moist_correction_in + real(kind_phys), intent(in) :: dust_drylimit_factor_in + integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in + integer, intent(in) :: drydep_opt_in + logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in + integer, intent(in) :: smoke_forecast_in, wind_eff_opt_in, plumerisefire_frq_in + integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in + logical, intent(in) :: do_plumerise_in, rrfs_sd + character(len=*),intent(out):: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + +!>-- Assign namelist values + !>-Dust + dust_alpha = dust_alpha_in + dust_gamma = dust_gamma_in + dust_moist_opt = dust_moist_opt_in + dust_moist_correction = dust_moist_correction_in + dust_drylimit_factor = dust_drylimit_factor_in + dust_opt = dust_opt_in + !>-Sea Salt + seas_opt = seas_opt_in + !>-Dry and wet deposition + drydep_opt = drydep_opt_in + pm_settling = pm_settling_in + wetdep_ls_opt = wetdep_ls_opt_in + wetdep_ls_alpha = wetdep_ls_alpha_in + !>-Smoke + do_rrfs_sd = rrfs_sd + ebb_dcycle = ebb_dcycle_in + do_plumerise = do_plumerise_in + plumerisefire_frq = plumerisefire_frq_in + addsmoke_flag = addsmoke_flag_in + smoke_forecast = smoke_forecast_in + wind_eff_opt = wind_eff_opt_in + !>-Feedback + aero_ind_fdb = aero_ind_fdb_in + !>-Other + extended_sd_diags = extended_sd_diags_in + dbg_opt = dbg_opt_in + + end subroutine rrfs_smoke_wrapper_init + !! \section arg_table_rrfs_smoke_wrapper_run Argument Table !! \htmlinclude rrfs_smoke_wrapper_run.html !! @@ -42,126 +110,108 @@ module rrfs_smoke_wrapper subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype, soiltyp, sigmaf, dswsfc, zorl, snow, julian, & - idat, rain_cpl, rainc_cpl, exch, hf2d, g, pi, con_cp, con_rd, con_fv, & - dust12m_in, emi_in, smoke_RRFS, ntrac, qgrs, gq0, chem3d, tile_num, & + nsoil, smc, vegtype_dom, vegtype_frac,soiltyp,nlcat, & + dswsfc, zorl, snow, julian,recmol, & + idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & + dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & + ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & - nwfa, nifa, emanoc, emdust, emseas, & - ebb_smoke_hr, frp_hr, frp_std_hr, & - coef_bb, ebu_smoke,fhist, min_fplume, max_fplume, hwp, wetness, & - smoke_ext, dust_ext, ndvel, ddvel_inout,rrfs_sd, & - dust_moist_opt_in, dust_moist_correction_in, dust_drylimit_factor_in, & - dust_alpha_in, dust_gamma_in, fire_in, & - seas_opt_in, dust_opt_in, drydep_opt_in, coarsepm_settling_in, & - do_plumerise_in, plumerisefire_frq_in, addsmoke_flag_in, & - wetdep_ls_opt_in,wetdep_ls_alpha_in, fire_heat_flux_out, & - frac_grid_burned_out, & - smoke_forecast_in, aero_ind_fdb_in,dbg_opt_in,errmsg,errflg) - + nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & + ebb_smoke_in, frp_input, coef_bb, ebu_smoke,fhist,min_fplume, & + max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & + errmsg,errflg ) + implicit none integer, intent(in) :: im,kte,kme,ktau,nsoil,tile_num,jdate(8),idat(8) - integer, intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel + integer, intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd, con_fv - logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in - integer, intent(in) :: smoke_forecast_in integer, parameter :: ids=1,jds=1,jde=1, kds=1 integer, parameter :: ims=1,jms=1,jme=1, kms=1 integer, parameter :: its=1,jts=1,jte=1, kts=1 - integer, dimension(:), intent(in) :: land, vegtype, soiltyp - real(kind_phys), dimension(:,:), intent(in) :: smc - real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in - real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS - real(kind_phys), dimension(:,:), intent(in) :: emi_in - real(kind_phys), dimension(:), intent(in) :: u10m, v10m, ustar, dswsfc, & - garea, rlat,rlon, tskin, pb2d, sigmaf, zorl, snow, & - rain_cpl, rainc_cpl, hf2d, t2m, dpt2m - real(kind_phys), dimension(:,:), intent(in) :: ph3d, pr3d - real(kind_phys), dimension(:,:), intent(in) :: phl3d, prl3d, tk3d, & - us3d, vs3d, spechum, exch, w + integer, dimension(:), intent(in) :: land, vegtype_dom, soiltyp + real(kind_phys), dimension(:,:), intent(in) :: smc + real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in + real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS + real(kind_phys), dimension(:,:), intent(in) :: smoke2d_RRFS + real(kind_phys), dimension(:,:), intent(in) :: emi_ant_in + real(kind_phys), dimension(:), intent(in) :: u10m, v10m, ustar, dswsfc, & + recmol, garea, rlat,rlon, tskin, pb2d, zorl, snow, & + rain_cpl, rainc_cpl, hf2d, t2m, dpt2m + real(kind_phys), dimension(:,:), intent(in) :: vegtype_frac + real(kind_phys), dimension(:,:), intent(in) :: ph3d, pr3d + real(kind_phys), dimension(:,:), intent(in) :: phl3d, prl3d, tk3d, us3d, vs3d, spechum, w real(kind_phys), dimension(:,:,:), intent(inout) :: qgrs, gq0 real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc - real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_hr, frp_hr, frp_std_hr - real(kind_phys), dimension(:), intent(inout) :: coef_bb, fhist - real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke - real(kind_phys), dimension(:,:), intent(inout) :: fire_in - real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out - real(kind_phys), dimension(:), intent(out) :: frac_grid_burned_out - real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume - real(kind_phys), dimension(:), intent( out) :: hwp - real(kind_phys), dimension(:,:), intent(out) :: smoke_ext, dust_ext - real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa - real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout - real(kind_phys), dimension(:), intent(in) :: wetness - real(kind_phys), intent(in) :: dust_alpha_in, dust_gamma_in, wetdep_ls_alpha_in - real(kind_phys), intent(in) :: dust_moist_correction_in - real(kind_phys), intent(in) :: dust_drylimit_factor_in - integer, intent(in) :: dust_moist_opt_in - integer, intent(in) :: imp_physics, imp_physics_thompson - integer, intent(in) :: seas_opt_in, dust_opt_in, drydep_opt_in, & - coarsepm_settling_in, plumerisefire_frq_in, & - addsmoke_flag_in, wetdep_ls_opt_in - logical, intent(in ) :: do_plumerise_in, rrfs_sd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - + real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc + real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_input, fhist + real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke + real(kind_phys), dimension(:,:), intent(inout) :: fire_in + real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out + real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume + real(kind_phys), dimension(:), intent( out) :: hwp + real(kind_phys), dimension(:), intent(inout) :: hwp_ave + real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa + real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout + real(kind_phys), dimension(:,:), intent(inout) :: drydep_flux_out + real(kind_phys), dimension(:,:), intent(inout) :: wetdpr + real(kind_phys), dimension(:), intent(in) :: wetness + integer, intent(in) :: imp_physics, imp_physics_thompson + integer, dimension(:), intent(in) :: kpbl + real(kind_phys), dimension(:), intent(in) :: oro + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!>-- Local Variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: ebu real(kind_phys), dimension(1:im, 1:kme,jms:jme) :: rri, t_phy, u_phy, v_phy, & - p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid, exch_h - + p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid real(kind_phys), dimension(ims:im, jms:jme) :: u10, v10, ust, tsk, & - xland, xlat, xlong, dxy, pbl, hfx, rcav, rnav - + xland, xlat, xlong, dxy, pbl, hfx, rnav, hwp_local, & + wetdpr_smoke_local, wetdpr_dust_local, wetdpr_coarsepm_local !>- sea salt & chemistry variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme, 1:num_moist) :: moist real(kind_phys), dimension(ims:im, kms:kme, jms:jme, 1:num_chem ) :: chem real(kind_phys), dimension(ims:im, 1, jms:jme, 1:num_emis_seas ) :: emis_seas real(kind_phys), dimension(ims:im, jms:jme) :: seashelp - +!>-- indexes, time integer :: ide, ime, ite, kde, julday - + real(kind_phys) :: gmt !>- dust & chemistry variables real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust - real(kind_phys), dimension(ims:im, jms:jme) :: vegfrac, rmol, swdown, znt, clayf, sandf + real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac + real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp - !>- plume variables ! -- buffers - real(kind_phys), dimension(ims:im, jms:jme) :: ebu_in - real(kind_phys), dimension(ims:im, jms:jme, num_frp_plume ) :: plume_frp - real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, & - fire_hist, peak_hr - real(kind_phys), dimension(ims:im,kms:kme,jms:jme ) :: ext3d_smoke, ext3d_dust - integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2 - logical :: call_fire + real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & + fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & + fire_end_hr, hwp_day_avg + integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type + logical :: call_fire, reset_hwp_ave !>- optical variables - real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: rel_hum - real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel - + real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local + real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav !>-- anthropogentic variables real(kind_phys), dimension(ims:im) :: emis_anoc real(kind_phys), dimension(ims:im, jms:jme, 1) :: sedim - - real(kind_phys) :: gmt - !> -- parameter to caluclate wfa&ifa (m) real(kind_phys), parameter :: mean_diameter1= 4.E-8, sigma1=1.8 real(kind_phys), parameter :: mean_diameter2= 1.E-6, sigma2=1.8 - real(kind_phys), parameter :: kappa_oc = 0.2 - real(kind_phys), parameter :: kappa_dust = 0.04 + ! real(kind_phys), parameter :: kappa_oc = 0.2 + ! real(kind_phys), parameter :: kappa_dust = 0.04 real(kind_phys) :: fact_wfa, fact_ifa !> -- aerosol density (kg/m3) real(kind_phys), parameter :: density_dust= 2.6e+3, density_sulfate=1.8e+3 real(kind_phys), parameter :: density_oc = 1.4e+3, density_seasalt=2.2e+3 - real(kind_phys), dimension(im) :: daero_emis_wfa, daero_emis_ifa -!>-- local variables +!> -- other real(kind_phys), dimension(im) :: wdgust, snoweq integer :: current_month, current_hour, hour_int real(kind_phys) :: curr_secs @@ -172,21 +222,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, errmsg = '' errflg = 0 - if (.not. rrfs_sd) return - -!>-- options to turn on/off sea-salt, dust, plume-rising - seas_opt = seas_opt_in - dust_opt = dust_opt_in - drydep_opt = drydep_opt_in - do_plumerise = do_plumerise_in - plumerisefire_frq = plumerisefire_frq_in - addsmoke_flag = addsmoke_flag_in - smoke_forecast = smoke_forecast_in - aero_ind_fdb = aero_ind_fdb_in - dbg_opt = dbg_opt_in - wetdep_ls_opt = wetdep_ls_opt_in - wetdep_ls_alpha = wetdep_ls_alpha_in - coarsepm_settling = coarsepm_settling_in + if (.not. do_rrfs_sd) return ! -- set domain ide=im @@ -199,19 +235,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, emis_seas = 0. emis_dust = 0. peak_hr = 0. + fire_type = 0 + lu_qfire = 0. + lu_nofire = 0. flam_frac = 0. - ext3d_smoke = 0. - ext3d_dust = 0. daero_emis_wfa = 0. daero_emis_ifa = 0. - rcav = 0. rnav = 0. curr_secs = ktau * dt current_month=jdate(2) ! needed for the dust input data current_hour =jdate(5)+1 ! =1 at 00Z - hour_int=ktau*dt/3600. ! hours since the simulation start + hour_int=ktau*dt/3600. ! hours since the simulation start gmt = real(mod(idat(5)+hour_int,24)) julday = int(julian) @@ -223,12 +259,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- compute incremental convective and large-scale rainfall do i=its,ite - rcav(i,1)=max(rainc_cpl(i)*1000. , 0.) ! meter to mm rnav(i,1)=max((rain_cpl(i)-rainc_cpl(i))*1000., 0.) ! meter to mm coef_bb_dc(i,1) = coef_bb(i) fire_hist (i,1) = fhist (i) enddo + ! Is this a reset timestep (00:00 + dt)? + reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 ! plumerise frequency in minutes set up by the namelist input call_fire = (do_plumerise .and. (plumerisefire_frq > 0)) @@ -236,57 +273,35 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>- get ready for chemistry run call rrfs_smoke_prep( & - current_month, current_hour, gmt, con_rd, con_fv, & + ktau,current_month, current_hour, gmt, con_rd, con_fv, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & - pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w, & - nsoil,smc,vegtype,soiltyp,sigmaf,dswsfc,zorl, & - snow,dust12m_in,emi_in,smoke_RRFS, & - hf2d, pb2d, g, pi, hour_int, & + pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & + nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & + hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,exch_h, & + t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & - moist,chem,plume_frp,ebu_in, & - ebb_smoke_hr, frp_hr, frp_std_hr, emis_anoc, & - smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,rel_hum, & + moist,chem,ebu_in,ebb_smoke_in, & + fhist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & + snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & + t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) - -! Make this global, calculate at 1st time step only -!>-- for plumerise -- + its,ite, jts,jte, kts,kte ) - do j=jts,jte - do i=its,ite - peak_hr(i,j)= fire_in(i,10) - enddo - enddo - - IF (ktau==1) THEN - do j=jts,jte - do i=its,ite - if (xlong(i,j)<230.) then - peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska - elseif(xlong(i,j)<245.) then - peak_hr(i,j)= 23.0* 3600. - elseif (xlong(i,j)<260.) then - peak_hr(i,j)= 22.0* 3600. ! peak at 22 UTC, fires in the western US - elseif (xlong(i,j)<275.) then - peak_hr(i,j)= 21.0* 3600. - elseif (xlong(i,j)<290.) then ! peak at 20 UTC, fires in the eastern US - peak_hr(i,j)= 20.0* 3600. - else - peak_hr(i,j)= 19.0* 3600. - endif - enddo - enddo - ENDIF + do j=jts,jte + do i=its,ite + peak_hr(i,j)= fire_in(i,1) + enddo + enddo - IF (ktau==1) THEN + IF (ktau==1) THEN ebu = 0. do j=jts,jte do i=its,ite @@ -296,18 +311,33 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo enddo enddo - ELSE - do k=kts,kte - do i=its,ite - ebu(i,k,1)=ebu_smoke(i,k) - enddo - enddo - ENDIF + ENDIF +!RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag +! or urban fires, 2- prescribed fires in wooded area, 3- wildfires + do j=jts,jte + do i=its,ite + if (ebu_in(i,j)<0.01) then + fire_type(i,j) = 0 + else + ! Permanent wetlands, snow/ice, water, barren tundra + lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) + ! cropland, urban, cropland/natural mosaic, barren and sparsely vegetated + lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) + if (lu_nofire(i,j)>0.95) then + fire_type(i,j) = 0 + else if (lu_qfire(i,j)>0.95) then + fire_type(i,j) = 1 + else + fire_type(i,j) = 3 ! RAR: need to add another criteria for fire_type=2, i.e. prescribed fires + end if + end if + end do + end do !>- compute sea-salt - ! -- compute sea salt (opt=2) - if (seas_opt == 2) then + ! -- compute sea salt (opt=1) + if (seas_opt == 1) then call gocart_seasalt_driver(dt,rri,t_phy, & u_phy,v_phy,chem,rho_phy,dz8w,u10,v10,ust,p8w,tsk, & xland,xlat,xlong,dxy,g,emis_seas,pi, & @@ -319,14 +349,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- compute dust (opt=5) if (dust_opt==DUST_OPT_FENGSHA) then - ! Set at compile time in dust_data_mod: - dust_alpha = dust_alpha_in - dust_gamma = dust_gamma_in - dust_moist_opt = dust_moist_opt_in - dust_moist_correction = dust_moist_correction_in - dust_drylimit_factor = dust_drylimit_factor_in call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & - isltyp,vegfrac,snowh,xland,dxy,g,emis_dust,ust,znt, & + isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & num_emis_dust,num_chem,nsoil, & ids,ide, jds,jde, kds,kde, & @@ -340,43 +364,50 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- /scratch2/BMC/ap-fc/Ravan/rapid-refresh/WRFV3.9/smoke ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag + !if (add_fire_heat_flux) then + do i = its,ite + if ( frp_in(i,1) .ge. 1.E7 ) then + fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & + 0.55/dxy(i,1)) ,5000.) ! JLS - W m-2 [0 - 10,000] + frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*coef_bb_dc(i,1)*frp_in(i,1)/dxy(i,1) ),1.) + else + fire_heat_flux_out(i) = 0.0 + frac_grid_burned_out(i) = 0.0 + endif + enddo + !endif if (call_fire) then call ebu_driver ( & flam_frac,ebu_in,ebu, & + coef_bb_dc, & t_phy,moist(:,:,:,p_qv), & rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,zmid,g,con_cp,con_rd, & - plume_frp, min_fplume2, max_fplume2, & ! new approach + frp_in, min_fplume2, max_fplume2, & ! new approach + wind_eff_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(errflg/=0) return - do i = its,ite - if ( plume_frp(i,1,p_frp_hr) .ge. 1.E7 ) then - fire_heat_flux_out(i) = min(max(0.,0.88*plume_frp(i,1,p_frp_hr)/0.55/dxy(i,1)) ,50000.) ! JLS - W m-2 [0 - 10,000] - frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*plume_frp(i,1,p_frp_hr)/dxy(i,1) ),1.) - else - fire_heat_flux_out(i) = 0.0 - frac_grid_burned_out(i) = 0.0 - endif - enddo end if + ! -- add biomass burning emissions at every timestep if (addsmoke_flag == 1) then - call add_emis_burn(dt,dz8w,rho_phy,rel_hum,chem, & - julday,gmt,xlat,xlong, & - ivgtyp, vegfrac, peak_hr, & ! RAR - curr_secs,ebu, & - coef_bb_dc,fire_hist,ext3d_smoke,ext3d_dust, & - rcav, rnav,swdown,smoke_forecast, & + call add_emis_burn(dt,dz8w,rho_phy,pi, & + chem,julday,gmt,xlat,xlong, & + fire_end_hr, peak_hr,curr_secs, & + coef_bb_dc,fire_hist,hwp_local,hwp_day_avg, & + swdown,ebb_dcycle,ebu_in,ebu,fire_type, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) endif - !>-- compute coarsepm setting - if (coarsepm_settling == 1) then - call coarsepm_settling_driver(dt,t_phy,rel_hum, & + !>-- compute coarsepm setting if using simple dry dep option and + ! pm_settling is on. This is necessary becasue the simple scheme + ! does not have an explicty settling routine, Emersion (opt=1) does. + if (drydep_opt == 2 .and. pm_settling == 1) then + call coarsepm_settling_driver(dt,t_phy, & chem(:,:,:,p_coarse_pm), & rho_phy,dz8w,p8w,p_phy,sedim, & dxy,g,1, & @@ -384,18 +415,29 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) endif - !>-- compute dry deposition + !>-- compute dry deposition, based on Emerson et al., (2020) if (drydep_opt == 1) then - - call dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & + call dry_dep_driver_emerson(rmol,ust,znt,ndvel,ddvel, & + vgrav,chem,dz8w,snowh,t_phy,p_phy,rho_phy,ivgtyp,g,dt, & + pm_settling,drydep_flux_local,settling_flux, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) - + its,ite, jts,jte, kts,kte ) do nv=1,ndvel - do i=its,ite - ddvel_inout(i,nv)=ddvel(i,1,nv) + do i=its,ite + ddvel_inout(i,nv)=ddvel(i,1,nv) + enddo enddo + !>-- compute dry deposition based on simple parameterization (HRRR-Smoke) + elseif (drydep_opt == 2) then + call dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + do nv=1,ndvel + do i=its,ite + ddvel_inout(i,nv)=ddvel(i,1,nv) + enddo enddo else ddvel_inout(:,:)=0. @@ -403,35 +445,49 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>- large-scale wet deposition if (wetdep_ls_opt == 1) then - call wetdep_ls(dt,chem,rnav,moist, & - rho_phy,num_chem,num_moist,dz8w,vvel, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call wetdep_ls(dt,chem,rnav,moist, & + rho_phy,num_chem,num_moist,ndvel, dz8w,vvel,& + wetdpr_smoke_local, wetdpr_dust_local, & + wetdpr_coarsepm_local, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + if ( extended_sd_diags ) then + do i = its, ite + wetdpr(i,1) = wetdpr(i,1) + wetdpr_smoke_local (i,1) + wetdpr(i,2) = wetdpr(i,2) + wetdpr_dust_local (i,1) + wetdpr(i,3) = wetdpr(i,3) + wetdpr_coarsepm_local(i,1) + enddo + endif endif +! Smoke emisisons diagnostic do k=kts,kte do i=its,ite ebu_smoke(i,k)=ebu(i,k,1) enddo enddo - !---- diagnostic output of hourly wildfire potential (07/2021) + if (ktau == 1 .or. reset_hwp_ave) then + hwp_ave = 0. + endif hwp = 0. do i=its,ite - wdgust(i)=max(1.68*sqrt(us3d(i,1)**2+vs3d(i,1)**2),3.) - snoweq(i)=max((25.-snow(i))/25.,0.) - hwp(i)=0.237*wdgust(i)**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq(i) ! Eric 08/2022 - enddo - -!---- diagnostic output of smoke & dust optical extinction (12/2021) - do k=kts,kte - do i=its,ite - smoke_ext(i,k) = ext3d_smoke(i,k,1) - dust_ext (i,k) = ext3d_dust (i,k,1) - enddo + hwp(i)=hwp_local(i,1) + hwp_ave(i) = hwp_ave(i) + hwp(i)*dt enddo + +!---- diagnostic output of dry deposition & gravitational settling fluxes + if ( drydep_opt == 1 .and. extended_sd_diags ) then + do nv = 1, ndvel + do i=its,ite + drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & + drydep_flux_local(i,1,nv) + & + settling_flux(i,1,nv) + enddo + enddo + endif !------------------------------------- !---- put smoke stuff back into tracer array do k=kts,kte @@ -455,20 +511,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im - emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + !emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + !emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & emis_dust(i,1,1,3) + emis_dust(i,1,1,4) ! dust emission: ug/m2/s - emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s coef_bb (i) = coef_bb_dc(i,1) + frp_input (i) = coef_bb_dc(i,1)*frp_in(i,1) fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) - emseas (i) = sandf(i,1) ! sand for dust - emanoc (i) = uthr (i,1) ! u threshold for dust enddo do i = 1, im - fire_in(i,10) = peak_hr(i,1) + fire_in(i,1) = peak_hr(i,1) enddo !-- to provide real aerosol emission for Thompson MP @@ -500,46 +555,51 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end subroutine rrfs_smoke_wrapper_run - subroutine rrfs_smoke_prep( & - current_month,current_hour,gmt,con_rd,con_fv, & - u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & - pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w, & - nsoil,smc,vegtype,soiltyp,sigmaf,dswsfc,zorl, & - snow_cpl,dust12m_in,emi_in,smoke_RRFS, & - hf2d, pb2d, g, pi, hour_int, & - u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,exch_h, & - z_at_w,vvel,zmid, & - ntrac,gq0, & - num_chem, num_moist, & - ntsmoke, ntdust, ntcoarsepm, & - moist,chem,plume_frp,ebu_in, & - ebb_smoke_hr, frp_hr, frp_std_hr, emis_anoc, & - smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,rel_hum, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & + subroutine rrfs_smoke_prep( & + ktau,current_month,current_hour,gmt,con_rd,con_fv, & + u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & + pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & + nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & + hf2d, pb2d, g, pi, hour_int, peak_hr, & + u10,v10,ust,tsk,xland,xlat,xlong,dxy, & + rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & + t8w,recmol, & + z_at_w,vvel,zmid, & + ntrac,gq0, & + num_chem, num_moist, & + ntsmoke, ntdust, ntcoarsepm, & + moist,chem,ebu_in,ebb_smoke_in, & + fhist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & + snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & + t2m,dpt2m,wetness,kpbl, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte) !Chem input configuration - integer, intent(in) :: current_month, current_hour, hour_int + integer, intent(in) :: current_month, current_hour, hour_int, nlcat !FV3 input variables - integer, intent(in) :: nsoil - integer, dimension(ims:ime), intent(in) :: land, vegtype, soiltyp + integer, intent(in) :: nsoil, ktau + integer, dimension(ims:ime), intent(in) :: land, vegtype_dom, soiltyp, kpbl integer, intent(in) :: ntrac real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv real(kind=kind_phys), dimension(ims:ime), intent(in) :: & - u10m, v10m, ustar, garea, rlat, rlon, ts2d, sigmaf, dswsfc, & - zorl, snow_cpl, pb2d, hf2d + u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & + zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol + real(kind=kind_phys), dimension(ims:ime, nlcat), intent(in) :: vegtype_frac real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc real(kind=kind_phys), dimension(ims:ime, 12, 5), intent(in) :: dust12m_in - real(kind=kind_phys), dimension(ims:ime, 24, 3), intent(in) :: smoke_RRFS - real(kind=kind_phys), dimension(ims:ime, 1), intent(in) :: emi_in + real(kind=kind_phys), dimension(ims:ime, 24, 2), intent(in) :: smoke_RRFS +! This is a place holder for ebb_dcycle == 2, currently set to hold a single +! value, which is the previous day's average of hwp, frp, ebb, fire_end + real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: smoke2d_RRFS + real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: emi_ant_in real(kind=kind_phys), dimension(ims:ime, kms:kme), intent(in) :: pr3d,ph3d real(kind=kind_phys), dimension(ims:ime, kts:kte), intent(in) :: & - phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w + phl3d,tk3d,prl3d,us3d,vs3d,spechum,w real(kind=kind_phys), dimension(ims:ime, kts:kte,ntrac), intent(in) :: gq0 @@ -551,37 +611,42 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, jms:jme),intent(out) :: ebu_in - real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp + ! real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp integer,dimension(ims:ime, jms:jme), intent(out) :: isltyp, ivgtyp real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: & rri, t_phy, u_phy, v_phy, p_phy, rho_phy, dz8w, p8w, t8w, vvel, & - zmid, exch_h, rel_hum + zmid real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: & - u10, v10, ust, tsk, xland, xlat, xlong, dxy, vegfrac, rmol, swdown, znt, & - pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr + u10, v10, ust, tsk, xland, xlat, xlong, dxy, rmol, swdown, znt, & + pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr, hwp_local + real(kind_phys), dimension(ims:ime, nlcat, jms:jme), intent(out) :: vegfrac real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_moist), intent(out) :: moist real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_chem), intent(out) :: chem real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: z_at_w real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois - real(kind_phys), dimension(ims:ime), intent(inout) :: ebb_smoke_hr, frp_hr, frp_std_hr - real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc - !real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr + real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in + ! real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) ! -- local variables - integer i,ip,j,k,kp,kk,kkp,nv,l,ll,n + integer i,ip,j,k,k1,kp,kk,kkp,nv,l,ll,n,nl + real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA,ZSF + real(kind_phys), dimension(ims:ime, kms:kme, jms:jme) :: THETAV + real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot,kpbl_thetav + real(kind_phys), parameter :: delta_theta4gust = 0.5 ! -- initialize fire emissions - !plume = 0._kind_phys - plume_frp = 0._kind_phys ebu_in = 0._kind_phys - ebb_smoke_hr = 0._kind_phys + ebb_smoke_in = 0._kind_phys emis_anoc = 0._kind_phys - frp_hr = 0._kind_phys - frp_std_hr = 0._kind_phys + frp_in = 0._kind_phys + hwp_day_avg = 0._kind_phys + fire_end_hr = 0._kind_phys ! -- initialize output arrays isltyp = 0._kind_phys @@ -597,7 +662,6 @@ subroutine rrfs_smoke_prep( & t8w = 0._kind_phys vvel = 0._kind_phys zmid = 0._kind_phys - exch_h = 0._kind_phys u10 = 0._kind_phys v10 = 0._kind_phys ust = 0._kind_phys @@ -621,7 +685,6 @@ subroutine rrfs_smoke_prep( & moist = 0._kind_phys chem = 0._kind_phys z_at_w = 0._kind_phys - rel_hum = 0._kind_phys do i=its,ite u10 (i,1)=u10m (i) @@ -642,12 +705,14 @@ subroutine rrfs_smoke_prep( & sandf(i,1)=dust12m_in(i,current_month,3) ssm (i,1)=dust12m_in(i,current_month,4) uthr (i,1)=dust12m_in(i,current_month,5) - ivgtyp (i,1)=vegtype(i) + ivgtyp (i,1)=vegtype_dom (i) isltyp (i,1)=soiltyp(i) - vegfrac(i,1)=sigmaf (i) + do nl = 1,nlcat + vegfrac(i,nl,1)=vegtype_frac (i,nl) + enddo + rmol (i,1)=recmol (i) enddo - rmol=0. do k=1,nsoil do j=jts,jte @@ -690,38 +755,30 @@ subroutine rrfs_smoke_prep( & p_phy(i,k,j)=prl3d(i,kkp) u_phy(i,k,j)=us3d(i,kkp) v_phy(i,k,j)=vs3d(i,kkp) - rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)*(1.+con_fv*spechum(i,kkp))) + ! from mp_thompson.F90 ; rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + ! from mynnd + rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) !*(1.+con_fv*spechum(i,kkp))) rri(i,k,j)=1./rho_phy(i,k,j) vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) if (t_phy(i,k,j) > 265.) then moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) - moist(i,k,j,3)=0. + !moist(i,k,j,3)=0. + ! TODO -- should we keep these limits? if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. else moist(i,k,j,2)=0. - moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) - if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. + ! moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) + ! TODO -- should we keep these limits? + ! if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. endif - !rel_hum(i,k,j) = min(0.95,spechum(i,kkp)) - rel_hum(i,k,j) = min(0.95, moist(i,k,j,1) / & - (3.80*exp(17.27*(t_phy(i,k,j)-273.)/ & - (t_phy(i,k,j)-36.))/(.01*p_phy(i,k,j)))) - rel_hum(i,k,j) = max(0.1,rel_hum(i,k,j)) !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo enddo enddo - ! -- the imported atmospheric heat diffusivity is only available up to kte-1 - do k=kts,kte-1 - do i=its,ite - exch_h(i,k,1)=exch(i,k) - enddo - enddo - do j=jts,jte do k=2,kte do i=its,ite @@ -739,24 +796,124 @@ subroutine rrfs_smoke_prep( & ! -- anthropogenic organic carbon do i=its,ite - emis_anoc(i) = emi_in(i,1) + emis_anoc(i) = emi_ant_in(i,1) enddo - if (hour_int<24) then - do j=jts,jte - do i=its,ite - ebb_smoke_hr(i) = smoke_RRFS(i,hour_int+1,1) ! smoke - frp_hr (i) = smoke_RRFS(i,hour_int+1,2) ! frp - frp_std_hr (i) = smoke_RRFS(i,hour_int+1,3) ! std frp - ebu_in (i,j) = ebb_smoke_hr(i) - plume_frp(i,j,p_frp_hr ) = conv_frp* frp_hr (i) - plume_frp(i,j,p_frp_std) = conv_frp* frp_std_hr (i) - enddo - enddo +!---- Calculate PBLH and K-PBL based on virtual potential temperature profile +!---- First calculate THETAV + do j = jts,jte + do i = its,ite + do k = kts,kte + THETA = t_phy(i,k,j) * (1.E5/p_phy(i,k,j))**0.286 + THETAV(i,k,j) = THETA * (1. + 0.61 * (moist(i,k,j,p_qv))) + enddo + enddo + enddo +!---- Now use the UPP code to deterimine the height and level + do i = its, ite + do j = jts, jte + if ( THETAV(i,kts+1,j) .lt. ( THETAV(i,kts,j) + delta_theta4gust) ) then + ZSF = oro(i) + do k = kts+1, kte + k1 = k +!--- give theta-v at the sfc a 0.5K boost in the PBLH definition + if ( THETAV(i,kts+k-1,j) .gt. ( THETAV(i,kts,j) + delta_theta4gust) ) then + exit + endif + enddo + kpbl_thetav(i,j) = k1 + !pblh_thetav(i,j) = zmid(i,k+k1-1,j) * & + ! ((THETAV(i,kts,j)+delta_theta4gust) - THETAV(i,kts+k1-1,j)) & + ! * (zmid(i,kts+k1-1,j) - zmid(i,kts+k1-2,j)) & + ! / (THETAV(i,kts+k1-1,j) - THETAV(i,kts+k1-2,j)) - ZSF + else + !pblh_thetav(i,j) = 0.0 + kpbl_thetav(i,j) = kts + 1 + endif + enddo + enddo + +!---- Calculate wind gust potential and HWP + do i = its,ite + SFCWIND = sqrt(u10m(i)**2+v10m(i)**2) + windgustpot(i,1) = SFCWIND + if (kpbl_thetav(i,1)+1 .ge. kts+1 ) then + do k=kts+1,kpbl_thetav(i,1)+1 + WIND = sqrt(us3d(i,k)**2+vs3d(i,k)**2) + DELWIND = WIND - SFCWIND + DZ = zmid(i,k,1) - oro(i) + DELWIND = DELWIND*(1.0-MIN(0.5,DZ/2000.)) + windgustpot(i,1) = max(windgustpot(i,1),SFCWIND+DELWIND) + enddo + endif + enddo + hwp_local = 0. + do i=its,ite + wdgust=max(windgustpot(i,1),3.) + snoweq=max((25.-snow_cpl(i))/25.,0.) + ! hwp_local(i,1)=0.237*wdgust**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq ! Eric original 08/2022 + hwp_local(i,1)=0.177*wdgust**0.97*max(t2m(i)-dpt2m(i),15.)**1.03*((1.-wetness(i))**0.4)*snoweq ! Eric update 11/2023 + enddo +! Set paramters for ebb_dcycle option + if (ebb_dcycle == 1 ) then + if (hour_int .le. 24) then + do j=jts,jte + do i=its,ite + + ebu_in (i,j) = smoke_RRFS(i,hour_int+1,1) ! smoke + frp_in (i,j) = smoke_RRFS(i,hour_int+1,2)*conv_frp ! frp + fire_end_hr(i,j) = 0.0 + hwp_day_avg(i,j) = 0.0 + ebb_smoke_in (i) = ebu_in(i,j) + if (ktau == 1) then + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. + endif + enddo + enddo + endif endif + ! RAR: here we need to initialize various arrays in order to apply HWP to + ! diurnal cycle + ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal + if (ebb_dcycle == 2) then + do i=its, ite + do j=jts, jte + ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. + frp_in (i,j) = smoke2d_RRFS(i,2)*conv_frp + fire_end_hr (i,j) = smoke2d_RRFS(i,3) + hwp_day_avg (i,j) = smoke2d_RRFS(i,4) + ebb_smoke_in(i ) = ebu_in(i,j) + ! Initialize to 1 on first time step, modified by add_emiss_burn thereafter + if (ktau == 1) then + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. + endif + enddo + enddo + end if - ! We will add a namelist variable, real :: flam_frac_global + if (ktau==1) then + do j=jts,jte + do i=its,ite + if (xlong(i,j)<230.) then + peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska + elseif(xlong(i,j)<245.) then + peak_hr(i,j)= 23.0* 3600. + elseif (xlong(i,j)<260.) then + peak_hr(i,j)= 22.0* 3600. ! peak at 22 UTC, fires in the western US + elseif (xlong(i,j)<275.) then + peak_hr(i,j)= 21.0* 3600. + elseif (xlong(i,j)<290.) then ! peak at 20 UTC, fires in the eastern US + peak_hr(i,j)= 20.0* 3600. + else + peak_hr(i,j)= 19.0* 3600. + endif + enddo + enddo + endif + ! We will add a namelist variable, real :: flam_frac_global do k=kms,kte do i=ims,ime chem(i,k,jts,p_smoke )=max(epsilc,gq0(i,k,ntsmoke )) @@ -765,9 +922,8 @@ subroutine rrfs_smoke_prep( & enddo enddo - - end subroutine rrfs_smoke_prep + !> @} end module rrfs_smoke_wrapper diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index 7b22b9799..fe664d31d 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,9 +1,184 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## +[ccpp-arg-table] + name = rrfs_smoke_wrapper_init + type = scheme +[seas_opt_in] + standard_name = control_for_smoke_sea_salt + long_name = rrfs smoke sea salt emission option + units = index + dimensions = () + type = integer + intent = in +[drydep_opt_in] + standard_name = control_for_smoke_dry_deposition + long_name = rrfs smoke dry deposition option + units = index + dimensions = () + type = integer + intent = in +[pm_settling_in] + standard_name = control_for_smoke_pm_settling + long_name = rrfs smoke pm settling option + units = index + dimensions = () + type = integer + intent = in +[wetdep_ls_opt_in] + standard_name = control_for_smoke_wet_deposition + long_name = rrfs smoke large scale wet deposition option + units = index + dimensions = () + type = integer + intent = in +[wetdep_ls_alpha_in] + standard_name = alpha_for_ls_wet_depoistion + long_name = alpha paramter for ls wet deposition + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[do_plumerise_in] + standard_name = do_smoke_plumerise + long_name = rrfs smoke plumerise option + units = index + dimensions = () + type = logical + intent = in +[plumerisefire_frq_in] + standard_name = smoke_plumerise_frequency + long_name = rrfs smoke add smoke option + units = min + dimensions = () + type = integer + intent = in +[wind_eff_opt_in] + standard_name = option_for_wind_effects_on_smoke_plumerise + long_name = wind effect plumerise option + units = index + dimensions = () + type = integer + intent = in +[addsmoke_flag_in] + standard_name = control_for_smoke_biomass_burning_emissions + long_name = rrfs smoke add smoke option + units = index + dimensions = () + type = integer + intent = in +[ebb_dcycle_in] + standard_name = control_for_diurnal_cycle_of_biomass_burning_emissions + long_name = rrfs smoke diurnal cycle option + units = index + dimensions = () + type = integer + intent = in +[smoke_forecast_in] + standard_name = do_smoke_forecast + long_name = index for rrfs smoke forecast + units = index + dimensions = () + type = integer + intent = in +[dust_opt_in] + standard_name = control_for_smoke_dust + long_name = rrfs smoke dust chem option + units = index + dimensions = () + type = integer + intent = in +[dust_alpha_in] + standard_name = alpha_fengsha_dust_scheme + long_name = alpha paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[dust_gamma_in] + standard_name = gamma_fengsha_dust_scheme + long_name = gamma paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[dust_moist_opt_in] + standard_name = control_for_dust_soil_moisture_option + long_name = smoke dust moisture parameterization 1 - fecan 2 - shao + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) + intent = in +[dust_moist_correction_in] + standard_name = dust_moist_correction_fengsha_dust_scheme + long_name = moisture correction term for fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) + intent = in +[dust_drylimit_factor_in] + standard_name = dust_drylimit_factor_fengsha_dust_scheme + long_name = moisture correction term for drylimit in fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) + intent = in +[aero_ind_fdb_in] + standard_name = do_smoke_aerosol_indirect_feedback + long_name = flag for rrfs wfa ifa emission + units = flag + dimensions = () + type = logical + intent = in +[extended_sd_diags_in] + standard_name = flag_for_extended_smoke_dust_diagnostics + long_name = flag for extended smoke dust diagnostics + units = flag + dimensions = () + type = logical + intent = in +[dbg_opt_in] + standard_name = do_smoke_debug + long_name = flag for rrfs smoke plumerise debug + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +##################################################################### [ccpp-arg-table] name = rrfs_smoke_wrapper_run type = scheme @@ -224,7 +399,7 @@ type = real kind = kind_phys intent = inout -[vegtype] +[vegtype_dom] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index @@ -238,11 +413,18 @@ dimensions = (horizontal_loop_extent) type = integer intent = in -[sigmaf] - standard_name = bounded_vegetation_area_fraction - long_name = areal fractional cover of green vegetation bounded on the bottom +[nlcat] + standard_name = number_of_vegetation_categories + long_name = number of vegetation categories + units = count + dimensions = () + type = integer + intent = in +[vegtype_frac] + standard_name = fraction_of_vegetation_category + long_name = fraction of horizontal grid area occupied by given vegetation category units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_vegetation_categories) type = real kind = kind_phys intent = in @@ -278,6 +460,14 @@ type = real kind = kind_phys intent = in +[recmol] + standard_name = reciprocal_of_obukhov_length + long_name = one over obukhov length + units = m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [idat] standard_name = date_and_time_at_model_initialization_in_iso_order long_name = initialization date and time @@ -301,14 +491,6 @@ type = real kind = kind_phys intent = in -[exch] - standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [hf2d] standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux valid for current call @@ -365,11 +547,11 @@ type = real kind = kind_phys intent = in -[emi_in] +[emi_ant_in] standard_name = anthropogenic_background_input long_name = anthropogenic background input units = various - dimensions = (horizontal_loop_extent,1) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -377,7 +559,15 @@ standard_name = emission_smoke_RRFS long_name = emission fire RRFS units = various - dimensions = (horizontal_loop_extent,24,3) + dimensions = (horizontal_loop_extent,24,2) + type = real + kind = kind_phys + intent = in +[smoke2d_RRFS] + standard_name = emission_smoke_prvd_RRFS + long_name = emission fire RRFS daily + units = various + dimensions = (horizontal_dimension,4) type = real kind = kind_phys intent = in @@ -494,7 +684,7 @@ type = real kind = kind_phys intent = inout -[ebb_smoke_hr] +[ebb_smoke_in] standard_name = surface_smoke_emission long_name = emission of surface smoke units = ug m-2 s-1 @@ -502,7 +692,7 @@ type = real kind = kind_phys intent = inout -[frp_hr] +[frp_input] standard_name = frp_hourly long_name = hourly fire radiative power units = MW @@ -510,14 +700,6 @@ type = real kind = kind_phys intent = inout -[frp_std_hr] - standard_name = frp_std_hourly - long_name = hourly stdandard deviation of fire radiative power - units = MW - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [coef_bb] standard_name = coef_bb_dc long_name = coef to estimate the fire emission @@ -558,6 +740,22 @@ type = real kind = kind_phys intent = inout +[drydep_flux_out] + standard_name = dry_deposition_flux + long_name = rrfs dry deposition flux + units = ug m-2 + dimensions = (horizontal_loop_extent,number_of_chemical_species_deposited) + type = real + kind = kind_phys + intent = inout +[wetdpr] + standard_name = mp_wet_deposition_smoke_dust + long_name = large scale wet deposition of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout [hwp] standard_name = hourly_wildfire_potential long_name = rrfs hourly fire weather potential @@ -566,6 +764,14 @@ type = real kind = kind_phys intent = out +[hwp_ave] + standard_name = hourly_wildfire_potential_average + long_name = rrfs hourly fire weather potential average + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [wetness] standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness @@ -574,22 +780,6 @@ type = real kind = kind_phys intent = in -[smoke_ext] - standard_name = extinction_coefficient_in_air_due_to_smoke - long_name = extinction coefficient in air due to smoke - units = various - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[dust_ext] - standard_name = extinction_coefficient_in_air_due_to_dust - long_name = extinction coefficient in air due to dust - units = various - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out [ndvel] standard_name = number_of_chemical_species_deposited long_name = number of chemical pbl deposited @@ -605,55 +795,6 @@ type = real kind = kind_phys intent = inout -[rrfs_sd] - standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[dust_moist_opt_in] - standard_name = control_for_dust_soil_moisture_option - long_name = smoke dust moisture parameterization 1 - fecan 2 - shao - units = index - dimensions = () - type = integer - active = (do_smoke_coupling) - intent = in -[dust_moist_correction_in] - standard_name = dust_moist_correction_fengsha_dust_scheme - long_name = moisture correction term for fengsha dust emission - units = none - dimensions = () - type = real - kind = kind_phys - active = (do_smoke_coupling) - intent = in -[dust_drylimit_factor_in] - standard_name = dust_drylimit_factor_fengsha_dust_scheme - long_name = moisture correction term for drylimit in fengsha dust emission - units = none - dimensions = () - type = real - kind = kind_phys - active = (do_smoke_coupling) - intent = in -[dust_alpha_in] - standard_name = alpha_fengsha_dust_scheme - long_name = alpha paramter for fengsha dust scheme - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[dust_gamma_in] - standard_name = gamma_fengsha_dust_scheme - long_name = gamma paramter for fengsha dust scheme - units = none - dimensions = () - type = real - kind = kind_phys - intent = in [fire_in] standard_name = smoke_fire_auxiliary_input long_name = smoke fire auxiliary input variables @@ -662,84 +803,6 @@ type = real kind = kind_phys intent = inout -[seas_opt_in] - standard_name = control_for_smoke_sea_salt - long_name = rrfs smoke sea salt emission option - units = index - dimensions = () - type = integer - intent = in -[dust_opt_in] - standard_name = control_for_smoke_dust - long_name = rrfs smoke dust chem option - units = index - dimensions = () - type = integer - intent = in -[drydep_opt_in] - standard_name = control_for_smoke_dry_deposition - long_name = rrfs smoke dry deposition option - units = index - dimensions = () - type = integer - intent = in -[coarsepm_settling_in] - standard_name = control_for_smoke_coarsepm_settling - long_name = rrfs smoke coarsepm settling option - units = index - dimensions = () - type = integer - intent = in -[wetdep_ls_opt_in] - standard_name = control_for_smoke_wet_deposition - long_name = rrfs smoke large scale wet deposition option - units = index - dimensions = () - type = integer - intent = in -[wetdep_ls_alpha_in] - standard_name = alpha_for_ls_wet_depoistion - long_name = alpha paramter for ls wet deposition - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[do_plumerise_in] - standard_name = do_smoke_plumerise - long_name = rrfs smoke plumerise option - units = index - dimensions = () - type = logical - intent = in -[plumerisefire_frq_in] - standard_name = smoke_plumerise_frequency - long_name = rrfs smoke add smoke option - units = min - dimensions = () - type = integer - intent = in -[addsmoke_flag_in] - standard_name = control_for_smoke_biomass_burning_emissions - long_name = rrfs smoke add smoke option - units = index - dimensions = () - type = integer - intent = in -[smoke_forecast_in] - standard_name = do_smoke_forecast - long_name = index for rrfs smoke forecast - units = index - dimensions = () - type = integer - intent = in -[aero_ind_fdb_in] - standard_name = do_smoke_aerosol_indirect_feedback - long_name = flag for rrfs wfa ifa emission - units = flag - dimensions = () - type = logical - intent = in [fire_heat_flux_out] standard_name = surface_fire_heat_flux long_name = heat flux of fire at the surface @@ -756,12 +819,20 @@ type = real kind = kind_phys intent = out -[dbg_opt_in] - standard_name = do_smoke_debug - long_name = flag for rrfs smoke plumerise debug - units = flag - dimensions = () - type = logical +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[oro] + standard_name = height_above_mean_sea_level + long_name = height_above_mean_sea_level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys intent = in [errmsg] standard_name = ccpp_error_message From 8180a05c4c44af50767d3cd32c724a9de6f2d21e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 7 Dec 2023 16:59:57 +0000 Subject: [PATCH 094/122] Omission from previous merge --- physics/SFC_Layer/UFS/sfc_nst.f | 696 ------------------- physics/{ => SFC_Layer/UFS}/sfc_nst.f90 | 0 physics/SFC_Layer/UFS/sfc_nst_post.f | 93 --- physics/{ => SFC_Layer/UFS}/sfc_nst_post.f90 | 0 physics/SFC_Layer/UFS/sfc_nst_pre.f | 96 --- physics/{ => SFC_Layer/UFS}/sfc_nst_pre.f90 | 0 6 files changed, 885 deletions(-) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst.f rename physics/{ => SFC_Layer/UFS}/sfc_nst.f90 (100%) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst_post.f rename physics/{ => SFC_Layer/UFS}/sfc_nst_post.f90 (100%) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst_pre.f rename physics/{ => SFC_Layer/UFS}/sfc_nst_pre.f90 (100%) diff --git a/physics/SFC_Layer/UFS/sfc_nst.f b/physics/SFC_Layer/UFS/sfc_nst.f deleted file mode 100644 index 2ca70666d..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst.f +++ /dev/null @@ -1,696 +0,0 @@ -!>\file sfc_nst.f -!! This file contains the GFS NSST model. - -!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. - module sfc_nst - - contains - -!>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module -!! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. -!> @{ -!! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. -!! \section arg_table_sfc_nst_run Argument Table -!! \htmlinclude sfc_nst_run.html -!! -!> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm - subroutine sfc_nst_run & - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: - & pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - & lseaspray, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & - & sinlat, stress, & - & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & - & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, thsfc_loc, & - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: - & ) -! -! ===================================================================== ! -! description: ! -! ! -! ! -! usage: ! -! ! -! call sfc_nst ! -! inputs: ! -! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! -! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! -! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, thsfc_loc, ! -! input/outputs: ! -! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! -! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! -! -- outputs: -! qsurf, gflux, cmm, chh, evap, hflx, ep ! -! ) -! ! -! ! -! subprogram/functions called: w3movdat, iw3jdn, fpvs, density, ! -! rhocoef, cool_skin, warm_layer, jacobi_temp. ! -! ! -! program history log: ! -! 2007 -- xu li createad original code ! -! 2008 -- s. moorthi adapted to the parallel version ! -! may 2009 -- y.-t. hou modified to include input lw surface ! -! emissivity from radiation. also replaced the ! -! often comfusing combined sw and lw suface ! -! flux with separate sfc net sw flux (defined ! -! as dn-up) and lw flux. added a program doc block. ! -! sep 2009 -- s. moorthi removed rcl and additional reformatting ! -! and optimization + made pa as input pressure unit.! -! 2009 -- xu li recreatead the code ! -! feb 2010 -- s. moorthi added some changes made to the previous ! -! version ! -! Jul 2016 -- X. Li, modify the diurnal warming event reset ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! inputs: size ! -! im - integer, horiz dimension 1 ! -! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind (m/s) im ! -! t1 - real, surface layer mean temperature ( k ) im ! -! q1 - real, surface layer mean specific humidity im ! -! tref - real, reference/foundation temperature ( k ) im ! -! cm - real, surface exchange coeff for momentum (m/s) im ! -! ch - real, surface exchange coeff heat & moisture(m/s) im ! -! lseaspray- logical, .t. for parameterization for sea spray 1 ! -! fm - real, a stability profile function for momentum im ! -! fm10 - real, a stability profile function for momentum im ! -! at 10m ! -! prsl1 - real, surface layer mean pressure (pa) im ! -! prslki - real, im ! -! prsik1 - real, im ! -! prslk1 - real, im ! -! wet - logical, =T if any ocn/lake water (F otherwise) im ! -! use_lake_model- logical, =T if flake model is used for lake im ! -! icy - logical, =T if any ice im ! -! xlon - real, longitude (radians) im ! -! sinlat - real, sin of latitude im ! -! stress - real, wind stress (n/m**2) im ! -! sfcemis - real, sfc lw emissivity (fraction) im ! -! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! -! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! -! rain - real, rainfall rate (kg/m**2/s) im ! -! timestep - real, timestep interval (second) 1 ! -! kdt - integer, time step counter 1 ! -! solhr - real, fcst hour at the end of prev time step 1 ! -! xcosz - real, consine of solar zenith angle 1 ! -! wind - real, wind speed (m/s) im ! -! flag_iter- logical, execution or not im ! -! when iter = 1, flag_iter = .true. for all grids im ! -! when iter = 2, flag_iter = .true. when wind < 2 im ! -! for both land and ocean (when nstf_name1 > 0) im ! -! flag_guess-logical, .true.= guess step to get CD et al im ! -! when iter = 1, flag_guess = .true. when wind < 2 im ! -! when iter = 2, flag_guess = .false. for all grids im ! -! nstf_name - integers , NSST related flag parameters 1 ! -! nstf_name1 : 0 = NSSTM off 1 ! -! 1 = NSSTM on but uncoupled 1 ! -! 2 = NSSTM on and coupled 1 ! -! nstf_name4 : zsea1 in mm 1 ! -! nstf_name5 : zsea2 in mm 1 ! -! lprnt - logical, control flag for check print out 1 ! -! ipr - integer, grid index for check print out 1 ! -! thsfc_loc- logical, flag for reference pressure in theta 1 ! -! ! -! input/outputs: -! li added for oceanic components -! tskin - real, ocean surface skin temperature ( k ) im ! -! tsurf - real, the same as tskin ( k ) but for guess run im ! -! xt - real, heat content in dtl im ! -! xs - real, salinity content in dtl im ! -! xu - real, u-current content in dtl im ! -! xv - real, v-current content in dtl im ! -! xz - real, dtl thickness im ! -! zm - real, mxl thickness im ! -! xtts - real, d(xt)/d(ts) im ! -! xzts - real, d(xz)/d(ts) im ! -! dt_cool - real, sub-layer cooling amount im ! -! d_conv - real, thickness of free convection layer (fcl) im ! -! z_c - sub-layer cooling thickness im ! -! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! -! c_d - coefficient2 to calculate d(tz)/d(ts) im ! -! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! -! w_d - coefficient4 to calculate d(tz)/d(ts) im ! -! ifd - real, index to start dtlm run or not im ! -! qrain - real, sensible heat flux due to rainfall (watts) im ! - -! outputs: ! - -! qsurf - real, surface air saturation specific humidity im ! -! gflux - real, soil heat flux (w/m**2) im ! -! cmm - real, im ! -! chh - real, im ! -! evap - real, evaperation from latent heat flux im ! -! hflx - real, sensible heat flux im ! -! ep - real, potential evaporation im ! -! ! -! ===================================================================== ! - use machine , only : kind_phys - use funcphys, only : fpvs - use date_def, only : idate - use module_nst_water_prop, only: get_dtzm_point - use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & - & sigma_r,solar_time_6am,ri_c,z_w_max,delz,wd_max, & - & rad2deg,const_rot,tau_min,tw_max,sst_max - use module_nst_water_prop, only: solar_time_from_julian, & - & density,rhocoef,compjd,grv & - &, sw_ps_9b - use nst_module, only : cool_skin,dtm_1p,cal_w,cal_ttop, & - & convdepth,dtm_1p_fca,dtm_1p_tla, & - & dtm_1p_mwa,dtm_1p_mda,dtm_1p_mta, & - & dtl_reset -! - implicit none - - integer, parameter :: kp = kind_phys -! -! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0_kp ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0_kp ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001_kp ! cos(89.994) - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - -! --- inputs: - integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & - & nstf_name5 - real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & - & epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice - real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tref, cm, ch, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, xlon, xcosz, & - & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind - real (kind=kind_phys), intent(in) :: timestep - real (kind=kind_phys), intent(in) :: solhr - -! For sea spray effect - logical, intent(in) :: lseaspray -! - logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet - integer, dimension(:), intent(in) :: use_lake_model -! &, icy - logical, intent(in) :: lprnt - logical, intent(in) :: thsfc_loc - -! --- input/outputs: -! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation - real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & - & tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & qsurf, gflux, cmm, chh, evap, hflx, ep - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals -! - integer :: k,i -! - real (kind=kind_phys), dimension(im) :: q0, qss, rch, - & rho_a, theta1, tv1, wndmag - - real(kind=kind_phys) elocp,tem,cpinv,hvapi -! -! nstm related prognostic fields -! - logical flag(im) - real (kind=kind_phys), dimension(im) :: - & xt_old, xs_old, xu_old, xv_old, xz_old,zm_old,xtts_old, - & xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old - - real(kind=kind_phys) ulwflx(im), nswsfc(im) -! real(kind=kind_phys) rig(im), -! & ulwflx(im),dlwflx(im), -! & slrad(im),nswsfc(im) - real(kind=kind_phys) alpha,beta,rho_w,f_nsol,sss,sep, - & cosa,sina,taux,tauy,grav,dz,t0,ttop0,ttop - - real(kind=kind_phys) le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich - real(kind=kind_phys) rnl_ts,hs_ts,hl_ts,rf_ts,q_ts - real(kind=kind_phys) fw,q_warm - real(kind=kind_phys) t12,alon,tsea,sstc,dta,dtz - real(kind=kind_phys) zsea1,zsea2,soltim - logical do_nst - -! external functions called: iw3jdn - integer :: iw3jdn -! -! parameters for sea spray effect -! - real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, - & bb1, hflxs, evaps, ptem -! -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, -! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, - real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, - & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 -! -!====================================================================================================== -cc - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nstf_name1 == 0) return ! No NSST model used - - cpinv = one/cp - hvapi = one/hvap - elocp = hvap/cp - - sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready -! -! flag for open water and where the iteration is on -! - do_nst = .false. - do i = 1, im -! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 - do_nst = do_nst .or. flag(i) - enddo - if (.not. do_nst) return -! -! save nst-related prognostic fields for guess run -! - do i=1, im -! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then - xt_old(i) = xt(i) - xs_old(i) = xs(i) - xu_old(i) = xu(i) - xv_old(i) = xv(i) - xz_old(i) = xz(i) - zm_old(i) = zm(i) - xtts_old(i) = xtts(i) - xzts_old(i) = xzts(i) - ifd_old(i) = ifd(i) - tskin_old(i) = tskin(i) - dt_cool_old(i) = dt_cool(i) - z_c_old(i) = z_c(i) - endif - enddo - - -! --- ... initialize variables. all units are m.k.s. unless specified. -! ps is in pascals, wind is wind speed, theta1 is surface air -! estimated from level 1 temperature, rho_a is air density and -! qss is saturation specific humidity at the water surface -!! - do i = 1, im - if ( flag(i) ) then - - nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) - wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - - q0(i) = max(q1(i), 1.0e-8_kp) - - if(thsfc_loc) then ! Use local potential temperature - theta1(i) = t1(i) * prslki(i) - else ! Use potential temperature referenced to 1000 hPa - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer - endif - - tv1(i) = t1(i) * (one + rvrdm1*q0(i)) - rho_a(i) = prsl1(i) / (rd*tv1(i)) - qss(i) = fpvs(tsurf(i)) ! pa - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa -! - evap(i) = zero - hflx(i) = zero - gflux(i) = zero - ep(i) = zero - -! --- ... rcp = rho cp ch v - - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) - -!> - Calculate latent and sensible heat flux over open water with tskin. -! at previous time step - evap(i) = elocp * rch(i) * (qss(i) - q0(i)) - qsurf(i) = qss(i) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) - endif - -! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', -! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) -! &,' tsurf=',tsurf(i) - endif - enddo - -! run nst model: dtm + slm -! - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - -!> - Call module_nst_water_prop::density() to compute sea water density. -!> - Call module_nst_water_prop::rhocoef() to compute thermal expansion -!! coefficient (\a alpha) and saline contraction coefficient (\a beta). - do i = 1, im - if ( flag(i) ) then - tsea = tsurf(i) - t12 = tsea*tsea - ulwflx(i) = sfcemis(i) * sbc * t12 * t12 - alon = xlon(i)*rad2deg - grav = grv(sinlat(i)) - soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp - call density(tsea,sss,rho_w) ! sea water density - call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta -! -!> - Calculate sensible heat flux (\a qrain) due to rainfall. -! - le = (2.501_kp-0.00237_kp*tsea)*1e6_kp - dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity - dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) - & * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) - alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w - qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) - -!> - Calculate input non solar heat flux as upward = positive to models here - - f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) - & + omg_sh*qrain(i) - -! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', -! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) -! &,' omg_sh=',omg_sh,' qrain=',qrain(i) - - sep = sss*(evap(i)/le-rain(i))/rho_w - ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity -! -! sensitivities of heat flux components to ts -! - rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) - hs_ts = rch(i) - hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) - rf_ts = tem * (one+rch(i)*hl_ts) - q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts -! -!> - Call cool_skin(), which is the sub-layer cooling parameterization -!! (Fairfall et al. (1996) \cite fairall_et_al_1996). -! & calculate c_0, c_d -! - call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta - &, rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le - &, dt_cool(i),z_c(i),c_0(i),c_d(i)) - - tem = one / wndmag(i) - cosa = u1(i)*tem - sina = v1(i)*tem - taux = max(stress(i),tau_min)*cosa - tauy = max(stress(i),tau_min)*sina - fc = const_rot*sinlat(i) -! -! Run DTM-1p system. -! - if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then - else - ifd(i) = one -! -! calculate fcl thickness with current forcing and previous time's profile -! -! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) - -!> - Call convdepth() to calculate depth for convective adjustments. - if ( f_nsol > zero .and. xt(i) > zero ) then - call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w - &, alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) - else - d_conv(i) = zero - endif - -! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) -! -! determine rich: wind speed dependent (right now) -! -! if ( wind(i) < 1.0 ) then -! rich = 0.25 + 0.03*wind(i) -! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then -! rich = 0.25 + 0.1*wind(i) -! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then -! rich = 0.25 + 0.6*wind(i) -! elseif ( wind(i) >= 6.0 ) then -! rich = 0.25 + min(0.8*wind(i),0.50) -! endif - - rich = ri_c - -!> - Call the diurnal thermocline layer model dtm_1p(). - call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), - & f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, - & sinlat(i),soltim,grav,le,d_conv(i), - & xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) - -! apply mda - if ( xt(i) > zero ) then -!> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply -!! minimum depth adjustment (mda). - call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then -!> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. - call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), - & xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' -! &,z_w_max - endif - -! apply fca - if ( d_conv(i) > zero ) then -!> - If thickness of free convection layer > 0.0, call dtm_1p_fca() -!! to apply free convection adjustment. -!> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). - call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) - -! apply tla - dz = min(xz(i),max(d_conv(i),delz)) -! -!> - Call sw_ps_9b() to compute the fraction of the solar radiation -!! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). -!! And calculate the total heat absorbed in warm layer. - call sw_ps_9b(delz,fw) - q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer - -!> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with -!! thickness of \a dz. - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho_w,dz, - & xt(i),xz(i),ttop0) - -! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', -! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), -! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), -! &' xz=',xz(i),' qrain=',qrain(i) - - ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) - -! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) -! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz -! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 - -!> - Call dtm_1p_tla() to apply top layer adjustment. - if ( ttop > ttop0 ) then - call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', -! &z_w_max - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - endif ! if ( q_warm > 0.0 ) then - -! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) - -! apply mwa -!> - Call dt_1p_mwa() to apply maximum warming adjustment. - t0 = (xt(i)+xt(i))/xz(i) - if ( t0 > tw_max ) then - call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) - -! apply mta -!> - Call dtm_1p_mta() to apply maximum temperature adjustment. - sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) - - if ( sstc > sst_max ) then - dta = sstc - sst_max - call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) -! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), -! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif -! - endif ! if ( xt(i) > 0.0 ) then -! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0_kp*timestep ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - - endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day - -! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) - -! update tsurf (when flag(i) .eqv. .true. ) -!> - Call get_dtzm_point() to computes \a dtz and \a tsurf. - call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), - & zsea1,zsea2,dtz) - tsurf(i) = max(tgice, tref(i) + dtz ) - -! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', -! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) - -!> - Call cal_w() to calculate \a w_0 and \a w_d. - if ( xt(i) > zero ) then - call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) - else - w_0(i) = zero - w_d(i) = zero - endif - -! if ( xt(i) > 0.0 ) then -! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) -! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) -! else -! rig(i) = 0.25 -! endif - -! qrain(i) = rig(i) - zm(i) = wind(i) - - endif - enddo - -! restore nst-related prognostic fields for guess run - do i=1, im -! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. use_lake_model(i)/=1) then - if (flag_guess(i)) then ! when it is guess of - xt(i) = xt_old(i) - xs(i) = xs_old(i) - xu(i) = xu_old(i) - xv(i) = xv_old(i) - xz(i) = xz_old(i) - zm(i) = zm_old(i) - xtts(i) = xtts_old(i) - xzts(i) = xzts_old(i) - ifd(i) = ifd_old(i) - tskin(i) = tskin_old(i) - dt_cool(i) = dt_cool_old(i) - z_c(i) = z_c_old(i) - else -! -! update tskin when coupled and not guess run -! (all other NSST variables have been updated in this case) -! - if ( nstf_name1 > 1 ) then - tskin(i) = tsurf(i) - endif ! if nstf_name1 > 1 then - endif ! if flag_guess(i) then - endif ! if wet(i) .and. .not.icy(i) then - enddo - -! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) - - if ( nstf_name1 > 1 ) then -!> - Calculate latent and sensible heat flux over open water with updated tskin -!! for the grids of open water and the iteration is on. - do i = 1, im - if ( flag(i) ) then - qss(i) = fpvs( tskin(i) ) - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) - qsurf(i) = qss(i) - evap(i) = elocp*rch(i) * (qss(i) - q0(i)) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tskin(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) - endif - - endif - enddo - endif ! if ( nstf_name1 > 1 ) then -! -!> - Include sea spray effects -! - do i=1,im - if(lseaspray .and. flag(i)) then - f10m = fm10(i) / fm(i) - u10m = f10m * u1(i) - v10m = f10m * v1(i) - ws10 = sqrt(u10m*u10m + v10m*v10m) - ws10 = max(ws10,1.) - ws10 = min(ws10,ws10cr) - tem = .015 * ws10 * ws10 - ru10 = 1. - .087 * log(10./tem) - qss1 = fpvs(t1(i)) - qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) - tem = rd * cp * t1(i) * t1(i) - tem = 1. + eps * hvap * hvap * qss1 / tem - bb1 = 1. / tem - evaps = conlf * (ws10**5.4) * ru10 * bb1 - evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) - evap(i) = evap(i) + alps * evaps - hflxs = consf * (ws10**3.4) * ru10 - hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) - ptem = alps - gams - hflx(i) = hflx(i) + bets * hflxs - ptem * evaps - endif - enddo -! - do i=1,im - if ( flag(i) ) then - tem = one / rho_a(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo -! -! if (lprnt) print *,' tskin=',tskin(ipr) - - return - end subroutine sfc_nst_run -!> @} - end module sfc_nst diff --git a/physics/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 similarity index 100% rename from physics/sfc_nst.f90 rename to physics/SFC_Layer/UFS/sfc_nst.f90 diff --git a/physics/SFC_Layer/UFS/sfc_nst_post.f b/physics/SFC_Layer/UFS/sfc_nst_post.f deleted file mode 100644 index 83bc2f273..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst_post.f +++ /dev/null @@ -1,93 +0,0 @@ -!> \file sfc_nst_post.f -!! This file contains code to be executed after the GFS NSST model. - - module sfc_nst_post - - contains - -! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post - -!> \section arg_table_sfc_nst_post_run Argument Table -!! \htmlinclude sfc_nst_post_run.html -!! -! \section NSST_general_post_algorithm General Algorithm -! -! \section NSST_detailed_post_algorithm Detailed Algorithm -! @{ - subroutine sfc_nst_post_run & - & ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & - & oro_uf, nstf_name1, & - & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & - & ) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, kdt, nthreads - logical, dimension(:), intent(in) :: wet, icy - integer, dimension(:), intent(in) :: use_lake_model - real (kind=kind_phys), intent(in) :: rlapse, tgice - real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf - integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 - real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, & - & dt_cool, z_c, tref, xlon - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, & - & tsfc_wat - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: dtzm - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys) :: zsea1, zsea2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), -! & ' kdt=',kdt - -! do i = 1, im -! if (wet(i) .and. .not. icy(i)) then -! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse -! endif -! enddo - -! --- ... run nsst model ... --- - - if (nstf_name1 > 1) then - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & - & im, 1, nthreads, dtzm) - do i = 1, im -! if (wet(i) .and. .not.icy(i)) then -! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. use_lake_model(i) /=1) then - tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) -! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & -! (oro(i)-oro_uf(i))*rlapse - endif - enddo - endif - -! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt - - return - end subroutine sfc_nst_post_run - - end module sfc_nst_post diff --git a/physics/sfc_nst_post.f90 b/physics/SFC_Layer/UFS/sfc_nst_post.f90 similarity index 100% rename from physics/sfc_nst_post.f90 rename to physics/SFC_Layer/UFS/sfc_nst_post.f90 diff --git a/physics/SFC_Layer/UFS/sfc_nst_pre.f b/physics/SFC_Layer/UFS/sfc_nst_pre.f deleted file mode 100644 index 77ff61f00..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst_pre.f +++ /dev/null @@ -1,96 +0,0 @@ -!> \file sfc_nst_pre.f -!! This file contains preparation for the GFS NSST model. - - module sfc_nst_pre - - contains - -!> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre -!! -!! The NSST scheme is one of the three schemes used to represent the -!! surface in the GFS physics suite. The other two are the Noah land -!! surface model and the sice simplified ice model. -!! -!! \section arg_table_sfc_nst_pre_run Argument Table -!! \htmlinclude sfc_nst_pre_run.html -!! -!> \section NSST_general_pre_algorithm General Algorithm - subroutine sfc_nst_pre_run - & (im, wet, tgice, tsfco, tsurf_wat, - & tseal, xt, xz, dt_cool, z_c, tref, cplflx, - & oceanfrac, nthreads, errmsg, errflg) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, nthreads - logical, dimension(:), intent(in) :: wet - real (kind=kind_phys), intent(in) :: tgice - real (kind=kind_phys), dimension(:), intent(in) :: - & tsfco, xt, xz, dt_cool, z_c, oceanfrac - logical, intent(in) :: cplflx - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: - & tsurf_wat, tseal, tref - -! --- outputs: - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys), parameter :: zero = 0.0_kp, - & one = 1.0_kp, - & half = 0.5_kp, - & omz1 = 2.0_kp - real(kind=kind_phys) :: tem1, tem2, dnsst - real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (wet(i) .and. oceanfrac(i) > 0.0) then -! tem = (oro(i)-oro_uf(i)) * rlapse - ! DH* 20190927 simplyfing this code because tem is zero - !tem = zero - !tseal(i) = tsfco(i) + tem - tseal(i) = tsfco(i) - !tsurf_wat(i) = tsurf_wat(i) + tem - ! *DH - endif - enddo -! -! update tsfc & tref with T1 from OGCM & NSST Profile if coupled -! - if (cplflx) then - z_c_0 = zero - call get_dtzm_2d (xt, xz, dt_cool, & - & z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) - do i=1,im - if (wet(i) .and. oceanfrac(i) > zero ) then -! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf - tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile -! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update -! tseal(i) = tsfc_wat(i) - if (abs(xz(i)) > zero) then - tem2 = one / xz(i) - else - tem2 = zero - endif - tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) - tsurf_wat(i) = tseal(i) - endif - enddo - endif - - return - end subroutine sfc_nst_pre_run - end module sfc_nst_pre diff --git a/physics/sfc_nst_pre.f90 b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 similarity index 100% rename from physics/sfc_nst_pre.f90 rename to physics/SFC_Layer/UFS/sfc_nst_pre.f90 From 3c1e819f5f1042917fcc68810254362252621315 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 7 Dec 2023 18:18:07 +0000 Subject: [PATCH 095/122] More metadata fixes --- physics/MP/GFDL/fv_sat_adj.meta | 4 +++- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/physics/MP/GFDL/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta index 8c3c9be42..c91e438b7 100644 --- a/physics/MP/GFDL/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_gfdl_cloud_microphys.F90,multi_gases.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = module_gfdl_cloud_microphys.F90,multi_gases.F90 + dependencies = ../module_mp_radar.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 44cb6aa5b..f3ce1d19b 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -2,7 +2,7 @@ name = lsm_noah type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90,namelist_soilveg.f ######################################################################## [ccpp-arg-table] From a7b8325bdf3f0a16f7354854276f40918b32549b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 14 Dec 2023 00:46:00 +0000 Subject: [PATCH 096/122] Bug in CMake file --- CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index bac0637a4..ee708d4c4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -108,8 +108,8 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte- # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) -if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90fv_sat_adj.F90 IN_LIST SCHEMES) - list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90/fv_sat_adj.F90) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90) endif() # Remove files that need to be compiled with different precision From d65507afb07edc4a50ba246843284552b99e437d Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 14 Dec 2023 11:16:29 -0500 Subject: [PATCH 097/122] Fix CI 2 --- tools/check_encoding.py | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tools/check_encoding.py b/tools/check_encoding.py index 1d24d4679..d964ebaab 100755 --- a/tools/check_encoding.py +++ b/tools/check_encoding.py @@ -15,11 +15,7 @@ if suffix in SUFFICES: with open(os.path.join(root, file)) as f: contents = f.read() - try: - contents.decode('ascii') - except UnicodeDecodeError: + if not contents.isascii(): for line in contents.split('\n'): - try: - line.decode('ascii') - except UnicodeDecodeError: + if not line.isascii(): raise Exception('Detected non-ascii characters in file {}, line: "{}"'.format(os.path.join(root, file), line)) From 3c3c91a57210a686f6c21bbe8cf614f37ac2b16b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 14 Dec 2023 22:37:37 +0000 Subject: [PATCH 098/122] bug fix: no concurrent NetCDF calls in GFS_phys_time_vary_init --- physics/GFS_phys_time_vary.fv3.F90 | 37 ------------------------------ 1 file changed, 37 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4b6909f74..f53ab3928 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -222,24 +222,6 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & -!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & -!$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & -!$OMP shared (iamin, iamax, jamin, jamax, lsm_noahmp) & -!$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) & -!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & -!$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & -!$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & -!$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & -!$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & -!$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & -!$OMP shared (ozphys) & -!$OMP private (ix,i,j,rsnow,vegtyp,myerrmsg,myerrflg) - -!$OMP sections - -!$OMP section !> - Call read_h2odata() to read stratospheric water vapor data need_h2odata: if(h2o_phys) then call read_h2odata (h2o_phys, me, master) @@ -263,7 +245,6 @@ subroutine GFS_phys_time_vary_init ( end if endif need_h2odata -!$OMP section !> - Call read_aerdata() to read aerosol climatology, Anning added coupled !> added coupled gocart and radiation option to initializing aer_nm if (iaerclm) then @@ -285,7 +266,6 @@ subroutine GFS_phys_time_vary_init ( ntrcaer = 1 endif -!$OMP section !> - Call read_cidata() to read IN and CCN data if (iccn == 1) then call read_cidata (me,master) @@ -293,7 +273,6 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP section !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then myerrflg = 0 @@ -302,14 +281,12 @@ subroutine GFS_phys_time_vary_init ( call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif -!$OMP section !> - Initialize soil vegetation (needed for sncovr calculation further down) myerrflg = 0 myerrmsg = 'set_soilveg failed without a message' call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) -!$OMP section !> - read in NoahMP table (needed for NoahMP init) if(lsm == lsm_noahmp) then myerrflg = 0 @@ -318,25 +295,19 @@ subroutine GFS_phys_time_vary_init ( call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif -!$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") -!$OMP sections - -!$OMP section !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif -!$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif -!$OMP section !> - Call setindxaer() to initialize aerosols data if (iaerclm) then call setindxaer (im, xlat_d, jindx1_aer, & @@ -349,7 +320,6 @@ subroutine GFS_phys_time_vary_init ( jamax = max(maxval(jindx2_aer), jamax) endif -!$OMP section !> - Call setindxci() to initialize IN and CCN data if (iccn == 1) then call setindxci (im, xlat_d, jindx1_ci, & @@ -357,14 +327,12 @@ subroutine GFS_phys_time_vary_init ( iindx1_ci, iindx2_ci, ddx_ci) endif -!$OMP section !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif -!$OMP section !--- initial calculation of maps local ix -> global i and j ix = 0 do j = 1,ny @@ -375,7 +343,6 @@ subroutine GFS_phys_time_vary_init ( enddo enddo -!$OMP section !--- if sncovr does not exist in the restart, need to create it if (all(sncovr < zero)) then if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' @@ -404,10 +371,6 @@ subroutine GFS_phys_time_vary_init ( endif endif -!$OMP end sections - -!$OMP end parallel - if (errflg/=0) return if (iaerclm) then From 929b716834927b0b832335ef189dad6a4470042b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 15 Dec 2023 16:55:14 +0000 Subject: [PATCH 099/122] pressure is not density --- physics/clm_lake.f90 | 20 +++++++++++--------- physics/clm_lake.meta | 32 ++++++++++++++++++++++++-------- 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 620f79a96..f9341c87b 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -238,7 +238,7 @@ subroutine calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) real(kind_lake) :: dz_lake(nlevlake) ! layer thickness for lake (m) real(kind_lake) :: depthratio - if (input_lakedepth(i) == spval) then + if (input_lakedepth(i) == spval .or. input_lakedepth(i) < 0.1) then clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) z_lake(1:nlevlake) = zlak(1:nlevlake) dz_lake(1:nlevlake) = dzlak(1:nlevlake) @@ -267,7 +267,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, tsfc, & flag_iter, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: @@ -283,7 +283,7 @@ SUBROUTINE clm_lake_run( & salty, savedtke12d, snowdp2d, h2osno2d, snl2d, t_grnd2d, t_lake3d, & lake_icefrac3d, t_soisno3d, h2osoi_ice3d, h2osoi_liq3d, h2osoi_vol3d, & - z3d, dz3d, zi3d, & + z3d, dz3d, zi3d, t1, qv1, prsl1, & input_lakedepth, clm_lakedepth, cannot_freeze, & ! Error reporting: @@ -321,8 +321,8 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & - dlwsfci, dswsfci, oro_lakedepth, wind, rho0, & - rainncprv, raincprv + dlwsfci, dswsfci, oro_lakedepth, wind, & + rainncprv, raincprv, t1, qv1, prsl1 REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -450,6 +450,7 @@ SUBROUTINE clm_lake_run( & logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE real(kind_lake) :: to_radians, lat_d, lon_d, qss, tkm, bd + real(kind_lake) :: rho0 ! lowest model level air density integer :: month,num1,num2,day_of_month,isl real(kind_lake) :: wght1,wght2,Tclim,depthratio @@ -693,12 +694,13 @@ SUBROUTINE clm_lake_run( & !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then - qfx = eflx_lh_tot(c)*invhvap + qfx = eflx_lh_tot(c)*invhvap else - qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) endif - evap_wat(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water - hflx_wat(i)=eflx_sh_tot(c)/(rho0(i)*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water + rho0 = prsl1(i) / (rair*t1(i)*(1.0 + con_fvirt*qv1(i))) + evap_wat(i) = qfx/rho0 ! kinematic_surface_upward_latent_heat_flux_over_water + hflx_wat(i) = eflx_sh_tot(c)/(rho0*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water gflx_wat(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water ep1d_water(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 11a44286a..345f535ee 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -305,14 +305,6 @@ type = real kind = kind_phys intent = in -[rho0] - standard_name = air_pressure_at_surface_adjacent_layer - long_name = mean pressure at lowest model layer - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -732,6 +724,30 @@ type = real kind = kind_phys intent = in +[t1] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[qv1] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[prsl1] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 0889de1446e11f26a0570baa056ceb0bfb65512e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 15:12:33 +0000 Subject: [PATCH 100/122] revisions to slowfall accumulation from @tanyasmirnova --- physics/module_sf_ruclsm.F90 | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 52fbc8123..9ac4493f7 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1703,7 +1703,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one - !snow_mosaic=0. ! ??? + snow_mosaic=0. ! ??? ENDIF IF (debug_print ) THEN @@ -2076,7 +2076,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia hfx = hfxs*(one-snowfrac) + hfx*snowfrac s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) - sublim = sublim*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac ALB = MAX(keep_snow_albedo*alb, & @@ -2088,10 +2087,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac mavail = mavails*(one-snowfrac) + one*snowfrac infiltr = infiltrs*(one-snowfrac) + infiltr*snowfrac @@ -2115,7 +2110,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia qvg = qvgs*(one-snowfrac) + qvg*snowfrac qsg = qsgs*(one-snowfrac) + qsg*snowfrac qcg = qcgs*(one-snowfrac) + qcg*snowfrac - sublim = eeta*snowfrac + sublim = eeta eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac @@ -2129,10 +2124,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia (emissn - emiss_snowfree) * snowfrac), emissn)) runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac IF (debug_print ) THEN print *,'SOILT combined on ice', soilt ENDIF @@ -2215,15 +2206,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (debug_print ) then !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then print *,'Snowfallac xlat, xlon',xlat,xlon - print *,'newsn,rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio + print *,'newsn [m],rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio print *,'Time-step newsn depth [m], swe [m]',newsn,newsn*rhonewsn print *,'Time-step smelt: swe [m]' ,smelt*delt print *,'Time-step sublim: swe,[kg m-2]',sublim*delt endif - snowfallac = snowfallac + max(zero,(newsn*rhonewsn - & ! source of snow (swe) [m] - (smelt+sublim*1.e-3_kind_phys)*delt*newsnowratio) & ! sink: melting and sublimation, (swe) [m] - /rhonewsn)*rhowater ! snow accumulation in snow depth [mm] + snowfallac = snowfallac + newsn * 1.e3_kind_phys ! accumulated snow depth [mm], using variable snow density IF (debug_print ) THEN !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then @@ -5596,7 +5585,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & nmelt = 1 soiltfrac=snowfrac*tfrz+(one-snowfrac)*SOILT QSG=min(QSG, QSN(soiltfrac,TBQ)/PP) - qvg=qsg + qvg=snowfrac*qsg+(one-snowfrac)*qvg T3 = STBOLT*TN*TN*TN UPFLUX = T3 * 0.5_kind_phys*(TN + SOILTfrac) XINET = EMISS*(GLW-UPFLUX) From 8f54257bb79106320d6d366fe62f67b4f0640f01 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 15:48:05 +0000 Subject: [PATCH 101/122] add new flag to track new clm lake freezing grid and let gfs sfclay update stibility variables --- physics/GFS_surface_composites_pre.F90 | 4 +++- physics/clm_lake.f90 | 9 ++++++++- physics/clm_lake.meta | 7 +++++++ physics/sfc_diff.f | 4 +++- physics/sfc_diff.meta | 7 +++++++ 5 files changed, 28 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 98b9fecd2..fd16dea59 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -241,8 +241,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l !mjz tsfcl(i) = huge endif + if (icy(i) .or. wet(i)) then ! init uustar_ice for all water/ice grids + uustar_ice(i) = uustar(i) + endif if (icy(i)) then ! Ice - uustar_ice(i) = uustar(i) is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if(lsm /= lsm_ruc .and. .not.is_clm) then weasd_ice(i) = weasd(i) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 620f79a96..64c458a36 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, ISLTYP, rainncprv, raincprv, & + flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,6 +325,8 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP ! @@ -754,6 +756,11 @@ SUBROUTINE clm_lake_run( & weasd(i) = weasdi(i) snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice + + if (icy(i) .eq. .false.) then + lake_freeze(i)=.true. + end if + ! Ice points are icy: icy(i)=.true. ! flag_nonzero_sea_ice_surface_fraction ice_points = ice_points+1 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 11a44286a..31d0bdb6e 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,6 +328,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [isltyp] standard_name = soil_type_classification long_name = soil type at each grid cell diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..0607748b6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,6 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) + & lake_freeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -90,6 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(in) :: lake_freeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -168,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i)) then + if(flag_iter(i) .or. lake_freeze(i) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index eb30b8c50..7abb703cd 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,6 +194,13 @@ dimensions = () type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From b1bb75a8fca26ef8f790eb091c6f9db62809a94b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 16:50:27 +0000 Subject: [PATCH 102/122] explain lakedepth corruption safeguards --- physics/clm_lake.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index f9341c87b..bc640e1e2 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -239,6 +239,9 @@ subroutine calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) real(kind_lake) :: depthratio if (input_lakedepth(i) == spval .or. input_lakedepth(i) < 0.1) then + ! This is a safeguard against: + ! 1. missing in the lakedepth database (== spval) + ! 2. errors in model cycling or unexpected changes in the orography database (< 0.1) clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) z_lake(1:nlevlake) = zlak(1:nlevlake) dz_lake(1:nlevlake) = dzlak(1:nlevlake) From c6e09641f25767d0008c7c555c2f10b53cb2d0aa Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 18:10:48 +0000 Subject: [PATCH 103/122] explain the snow_mosaic=0 line --- physics/module_sf_ruclsm.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 9ac4493f7..b15592052 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1703,6 +1703,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one + ! turn off separate treatment of snow covered and snow-free portions of the grid cell snow_mosaic=0. ! ??? ENDIF From 99997c677be9f60768a467996fb99ff993f51b0f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:23:19 +0000 Subject: [PATCH 104/122] change lake_freeze intent to input only in sfc_diff meta --- physics/sfc_diff.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 7abb703cd..d10a29d29 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -200,7 +200,7 @@ units = flag dimensions = (horizontal_loop_extent) type = logical - intent = inout + intent = in [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From 2ceb88bb7c32f37e80c63deba174c8ebb1240a85 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:49:05 +0000 Subject: [PATCH 105/122] add missing parentheses --- physics/sfc_diff.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0607748b6..bf2e8cde0 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i) then + if(flag_iter(i) .or. lake_freeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 From 8941516ed69145557a90794a2fb1253e373c3661 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 00:31:25 +0000 Subject: [PATCH 106/122] fix compiling error for gnu --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 64c458a36..f58da2fa3 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -757,7 +757,7 @@ SUBROUTINE clm_lake_run( & snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice - if (icy(i) .eq. .false.) then + if (.not. icy(i)) then lake_freeze(i)=.true. end if From 0fbcc9f62ad182ded98fcde2e4c2287ee3334738 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 15:22:38 +0000 Subject: [PATCH 107/122] change name of lake_freeze to flag_lakefreeze --- physics/clm_lake.f90 | 6 +++--- physics/clm_lake.meta | 2 +- physics/sfc_diff.f | 6 +++--- physics/sfc_diff.meta | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index f58da2fa3..77d647812 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,7 +325,7 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter - LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + LOGICAL, DIMENSION(:), INTENT(INOUT) :: flag_lakefreeze INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -758,7 +758,7 @@ SUBROUTINE clm_lake_run( & if (.not. icy(i)) then - lake_freeze(i)=.true. + flag_lakefreeze(i)=.true. end if ! Ice points are icy: diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 31d0bdb6e..5c454dd11 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,7 +328,7 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index bf2e8cde0..c5ed8bfa6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,7 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) - & lake_freeze, & !intent(in) + & flag_lakefreeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -91,7 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy - logical, dimension(:), intent(in) :: lake_freeze + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i)) then + if(flag_iter(i) .or. flag_lakefreeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index d10a29d29..1aaad7239 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,7 +194,7 @@ dimensions = () type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag From a9208405adffd6b1b6389ac3f1331097b05069ad Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 16:45:32 +0000 Subject: [PATCH 108/122] remove excess whitespace --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 77d647812..607c0b2df 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & From 65358b905b40f16f4c5ee312025fb9cfc37dce89 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Tue, 19 Dec 2023 19:23:49 +0000 Subject: [PATCH 109/122] "update to address code reviewers' comments" --- physics/cu_gf_deep.F90 | 25 +- physics/cu_gf_driver.F90 | 7 +- physics/cu_gf_driver.meta | 2 +- physics/cu_gf_driver_post.F90 | 4 +- physics/cu_gf_driver_post.meta | 2 +- physics/cu_gf_driver_pre.F90 | 4 +- physics/cu_gf_driver_pre.meta | 2 +- physics/smoke_dust/coarsepm_settling_mod.F90 | 1 - physics/smoke_dust/dep_dry_mod_emerson.F90 | 104 ++------ physics/smoke_dust/dep_dry_simple_mod.F90 | 5 - physics/smoke_dust/dust_fengsha_mod.F90 | 3 - physics/smoke_dust/module_add_emiss_burn.F90 | 84 +++---- physics/smoke_dust/module_plumerise.F90 | 172 +++++++++++++ physics/smoke_dust/module_plumerise1.F90 | 225 ------------------ physics/smoke_dust/module_smoke_plumerise.F90 | 4 +- physics/smoke_dust/module_wetdep_ls.F90 | 3 + physics/smoke_dust/plume_data_mod.F90 | 1 - physics/smoke_dust/rrfs_smoke_config.F90 | 3 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 156 ++++++------ physics/smoke_dust/rrfs_smoke_wrapper.meta | 17 +- physics/smoke_dust/seas_mod.F90 | 1 - 22 files changed, 354 insertions(+), 473 deletions(-) create mode 100755 physics/smoke_dust/module_plumerise.F90 delete mode 100755 physics/smoke_dust/module_plumerise1.F90 diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index ab72c662c..b45452000 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -223,6 +223,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,nchem) & , intent (out) :: wetdpc_deep real(kind=kind_phys), intent (in) :: fscav(:) +!$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) real(kind=kind_phys) & ,intent (in ) :: & @@ -314,6 +315,8 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (kts:kte) :: trac,trcflx_in,trcflx_out,trc,trco real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx integer :: nv +!$acc declare create(chem,chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd, & +!$acc chem_pwav,chem_psum,pwdper,massflux) real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & @@ -424,7 +427,7 @@ subroutine cu_gf_deep_run( & integer, dimension (its:ite,kts:kte) :: k_inv_layers real(kind=kind_phys), dimension (its:ite) :: c0 ! HCB real(kind=kind_phys), dimension (its:ite,kts:kte) :: c0t3d ! hli for smoke/dust wet scavenging -!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0) +!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0,c0t3d) ! rainevap from sas real(kind=kind_phys) zuh2(40) @@ -2046,6 +2049,7 @@ subroutine cu_gf_deep_run( & ! initialize tracers if they exist ! chem (:,:,:) = 0. +!$acc kernels do nv = 1,nchem do k = 1, ktf do i = 1, itf @@ -2069,7 +2073,7 @@ subroutine cu_gf_deep_run( & do i=its,itf if(ierr(i).eq.0)then do k=kts,jmin(i) - pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) + if(pwavo(i).ne.0.) pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) enddo pwdper(i,:)=0. do nv=1,nchem @@ -2094,8 +2098,6 @@ subroutine cu_gf_deep_run( & trash=chem_c(i,k,nv)/(1.+c0t3d(i,k)*dz) chem_pw=c0t3d(i,k)*dz*trash*zuo(i,k) chem_up(i,k,nv)=trash2+trash -! chem_pw(i,k,nv)=min(chem_up(i,k,nv),chem_c(i,k,nv)*pwo(i,k)/zuo(i,k)/(1.e-8+qrco(i,k))) -! chem_up(i,k,nv)=chem_up(i,k,nv)-chem_pw(i,k,nv) chem_pwav(i,nv)=chem_pwav(i,nv)+chem_pw(i,k,nv)! *g/dp enddo do k=ktop(i)+1,ktf @@ -2109,11 +2111,11 @@ subroutine cu_gf_deep_run( & do ki=jmin(i),2,-1 dp=100.*(po_cup(i,ki)-po_cup(i,ki+1)) chem_down(i,ki,nv)=(chem_down(i,ki+1,nv)*zdo(i,ki+1) & - -.5*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & + -.5_kind_phys*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & dd_massentro(i,ki)*chem(i,ki,nv)) / & - (zdo(i,ki+1)-.5*dd_massdetro(i,ki)+dd_massentro(i,ki)) + (zdo(i,ki+1)-.5_kind_phys*dd_massdetro(i,ki)+dd_massentro(i,ki)) chem_down(i,ki,nv)=chem_down(i,ki,nv)+pwdper(i,ki)*chem_pwav(i,nv) - chem_pwd(i,ki,nv)=max(0.,pwdper(i,ki)*chem_pwav(i,nv)) + chem_pwd(i,ki,nv)=max(0._kind_phys,pwdper(i,ki)*chem_pwav(i,nv)) enddo ! total wet deposition do k=1,ktf-1 @@ -2167,6 +2169,7 @@ subroutine cu_gf_deep_run( & dellac2(:,:,:)=0. massflx(:,:)=0. do nv=1,nchem +!$acc loop private(trcflx_in) do i=its,itf if(ierr(i).eq.0)then trcflx_in(:)=0. @@ -2174,8 +2177,8 @@ subroutine cu_gf_deep_run( & ! initialize fct routine do k=kts,ktop(i) - dp=100.*(po_cup(i,k)-po_cup(i,k+1)) - dtime_max=min(dtime_max,.5*dp) + dp=100._kind_phys*(po_cup(i,k)-po_cup(i,k+1)) + dtime_max=min(dtime_max,.5_kind_phys*dp) massflx(i,k)=-xmb(i)*(zuo(i,k)-edto(i)*zdo(i,k)) trcflx_in(k)=massflx(i,k)*chem_cup(i,k,nv) enddo @@ -2212,6 +2215,7 @@ subroutine cu_gf_deep_run( & wetdpc_deep(i,nv)=max(wetdpc_deep(i,nv),qamin) enddo enddo +!$acc end kernels endif ! nchem > 0 @@ -4345,6 +4349,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ,intent (in ) :: & kbcon,ktop,k22,xland1 !$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1) +!$acc declare copy(c0t3d) real(kind=kind_phys), intent (in ) :: & ! HCB ccnclean ! @@ -4421,7 +4426,9 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0_iceconv=0.01 c1d_b=c1d bdsp(:)=bdispm +!$acc kernels c0t3d = 0. +!$acc end kernels ! !--- no precip for small clouds diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index d8bc11629..e4a78b030 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -155,9 +155,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: imfshalcnv integer, dimension(:), intent(inout) :: cactiv,cactiv_m real(kind_phys), dimension(:), intent(in) :: fscav +!$acc declare copyin(fscav) real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep -!$acc declare copy(cactiv,cactiv_m) +!$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -188,14 +189,14 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm integer, dimension (im) :: kbconm,ktopm,k22m !$acc declare create(k22_shallow,kbcon_shallow,ktop_shallow,rand_mom,rand_vmas, & -!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd, & +!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd,wetdpc_mid, & !$acc outt,outq,outqc,phh,subm,cupclw,cupclws, & !$acc dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm, & !$acc outts,outqs,outqcs,outu,outv,outus,outvs, & !$acc outtm,outqm,outqcm,submm,cupclwm, & !$acc cnvwt,cnvwts,cnvwtm,hco,hcdo,zdo,zdd,hcom,hcdom,zdom, & !$acc tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi, & -!$acc pret,prets,pretm,hexec,forcing,forcing2, & +!$acc pret,prets,pretm,hexec,forcing,forcing2,wetdpc_mid, & !$acc kbcon, ktop,ierr,ierrs,ierrm,kpbli, & !$acc k22s,kbcons,ktops,k22,jmin,jminm,kbconm,ktopm,k22m) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d6d874f7e..dce20064a 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -614,7 +614,7 @@ intent = in [nchem] standard_name = number_of_chemical_species_vertically_mixed - long_name = number of chemical vertically mixed + long_name = number of chemical species vertically mixed units = count dimensions = () type = integer diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 1700fbde9..6ed1321bc 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -35,7 +35,7 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) character(len=*), intent(out) :: errmsg -!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) +!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m,chem3d,gq0) integer, intent(out) :: errflg ! Local variables @@ -61,13 +61,13 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m conv_act_m(i)=0.0 endif enddo -!$acc end kernels if (rrfs_sd) then gq0(:,:,ntsmoke ) = chem3d(:,:,1) gq0(:,:,ntdust ) = chem3d(:,:,2) gq0(:,:,ntcoarsepm) = chem3d(:,:,3) endif +!$acc end kernels end subroutine cu_gf_driver_post_run diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 4c04224dc..f8320d5c9 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -85,7 +85,7 @@ intent = out [rrfs_sd] standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) + long_name = flag controlling rrfs_sd collection units = flag dimensions = () type = logical diff --git a/physics/cu_gf_driver_pre.F90 b/physics/cu_gf_driver_pre.F90 index 6be7b8aec..7ff66be21 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/cu_gf_driver_pre.F90 @@ -44,7 +44,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(in) :: conv_act(:) real(kind_phys), intent(in) :: conv_act_m(:) real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) -!$acc declare copyin(conv_act,conv_act_m) +!$acc declare copyin(conv_act,conv_act_m) copy(chem3d,gq0) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -81,13 +81,13 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, !$acc kernels cactiv(:)=nint(conv_act(:)) cactiv_m(:)=nint(conv_act_m(:)) -!$acc end kernels if (rrfs_sd) then chem3d(:,:,1) = gq0(:,:,ntsmoke) chem3d(:,:,2) = gq0(:,:,ntdust) chem3d(:,:,3) = gq0(:,:,ntcoarsepm) endif +!$acc end kernels end subroutine cu_gf_driver_pre_run diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 6d8787d06..49cc98148 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -124,7 +124,7 @@ intent = in [rrfs_sd] standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) + long_name = flag controlling rrfs_sd collection units = flag dimensions = () type = logical diff --git a/physics/smoke_dust/coarsepm_settling_mod.F90 b/physics/smoke_dust/coarsepm_settling_mod.F90 index 49f229453..b044edb67 100755 --- a/physics/smoke_dust/coarsepm_settling_mod.F90 +++ b/physics/smoke_dust/coarsepm_settling_mod.F90 @@ -64,7 +64,6 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy, & airmas(1,1,kk)=-(p8w(i,k+1,j)-p8w(i,k,j))*area(i,j)/g airden(1,1,kk)=rho_phy(i,k,j) tmp(1,1,kk)=t_phy(i,k,j) -! rh(1,1,kk) = rel_hum(i,k,j) ! hli do nv = 1, num_chem chem_before(i,j,k,nv) = chem(i,k,j,nv) enddo diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index d2d34bb4e..76fdc2411 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -9,7 +9,7 @@ module dep_dry_emerson_mod use machine , only : kind_phys use dep_data_mod ! JLS - use rrfs_smoke_config + use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm implicit none @@ -20,7 +20,7 @@ module dep_dry_emerson_mod contains subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & chem,delz,snowh,t_phy,p_phy,rho_phy,ivgtyp,g0,dt, & - settling_flag,drydep_flux,settling_flux, & + settling_flag,drydep_flux,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -38,13 +38,14 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & - INTENT(INOUT) :: ustar, rmol, znt, snowh + INTENT(IN) :: ustar, rmol, znt, snowh REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & INTENT(IN ) :: t_phy, rho_phy, p_phy, delz INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: ivgtyp REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem REAL(kind_phys), INTENT(IN) :: g0,dt + LOGICAL, INTENT(IN) :: dbg_opt ! ! Output arrays REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(INOUT) :: ddvel @@ -73,6 +74,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & real(kind_phys) :: Rs ! Surface resistance real(kind_phys) :: vgpart real(kind_phys) :: growth_fac,vsettl,dtmax,conver,converi,dzmin + real(kind_phys) :: rmol_local real(kind_phys), dimension( kts:kte) :: rho_col, delz_col real(kind_phys), dimension(ndvel) :: dt_settl, chem_before, chem_after real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col @@ -93,6 +95,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & do j = jts, jte do i = its, ite aer_res(i,j) = 0.0 + rmol_local = rmol(i,j) do k = kts, kte delz_col(k) = delz(i,k,j) rho_col(k) = rho_phy(i,k,j) @@ -108,14 +111,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ! where beta = 1.458e-6 [ kg sec^-1 K**-0.5 ], s = 110.4 [ K ]. amu = 1.458E-6 * t_phy(i,k,j) * sqrt(t_phy(i,k,j)) / ( t_phy(i,k,j) + 110.4 ) ! Aerodynamic resistance - call depvel( rmol(i,j), dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) + call depvel( rmol_local, dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) ! depvel uses meters, need to convert to s/cm - aer_res(i,j) = max(aer_res(i,j)/100.,0.) - ! Get the aerosol properties dp and aerodens and mean free path (xlm) - ! FOR RRFS-SD, diameters and densities are explicityly defined - !call modpar( cblk,t_phy(i,k,j),p_phy(i,k,j), amu, & - ! pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & - ! dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm, ndvel ) + aer_res(i,j) = max(aer_res(i,j)/100._kind_phys,0._kind_phys) ! Air kinematic viscosity (cm^2/s) airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 @@ -182,6 +180,10 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] ! The /100. term converts from cm/s to m/s, required for MYNN. ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) + if ( dbg_opt ) then + WRITE(6,*) 'dry_dep_mod_emerson: i,j,nv',i,j,nv + WRITE(6,*) 'dry_dep_mod_emerson: deposition velocity (m/s) ',ddvel(i,j,nv) + endif drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 endif ! k == kts @@ -216,9 +218,10 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ndt_settl(nv) = MAX( 1, INT( ntdt /dtmax) ) ! Limit maximum number of iterations IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 - dt_settl(nv) = REAL(ntdt) / REAL(ndt_settl(nv)) + dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo do nv = 1, ndvel + chem_before(nv) = 0._kind_phys do k = kts, kte chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo @@ -229,6 +232,8 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & endif ! Put cblk back into chem array do nv= 1, ndvel + chem_after(nv) = 0._kind_phys + settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 @@ -302,7 +307,7 @@ subroutine depvel( rmol, zr, z0, ustar, vgpart, aer_res ) ELSE IF (rmol==0.) THEN polint = 0.74*alog(zr/z0) ELSE - polint = 0.74*alog(zr/z0) + 4.7*rmol*(zr-z0) + polint = 0.74_kind_phys*alog(zr/z0) + 4.7_kind_phys*rmol*(zr-z0) END IF vgpart = ustar*vk/polint aer_res = polint/(karman*max(ustar,1.0e-4)) @@ -310,81 +315,6 @@ end subroutine depvel ! !-------------------------------------------------------------------------------- ! -subroutine modpar( cblk, blkta, blkprs, amu, & - pmassn,pmassa,pmassc, pdensn,pdensa,pdensc, & - dgnuc,dgacc,dgcor,knnuc,knacc,kncor, xlm,ndvel ) - IMPLICIT NONE - - INTEGER, INTENT(IN) :: ndvel - REAL(kind_phys), DIMENSION(ndvel), INTENT( IN) :: cblk - REAL(kind_phys), INTENT(IN ) :: blkta, blkprs, amu - REAL(kind_phys), INTENT(OUT) :: pmassn,pmassa,pmassc,pdensn,pdensa,pdensc, & - dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm -! -! Local - REAL(kind_phys) :: xxlsgn,xxlsga,xxlsgc,l2sginin,l2sginia,l2sginic, & - en1,ea1,ec1,esn04,esa04,esc04, & - esn08,esa08,esc08,esn16,esa16,esc16, & - esn20,esa20,esc20,esn36,esa36,esc36 - REAL(kind_phys), DIMENSION( 6 ) :: nblk ! number densities -! Pointers - INTEGER, PARAMETER :: vnu0 = 1 - INTEGER, PARAMETER :: vac0 = 2 - INTEGER, PARAMETER :: vcorn = 3 - INTEGER, PARAMETER :: vnu3 = 4 - INTEGER, PARAMETER :: vac3 = 5 - INTEGER, PARAMETER :: vcor3 = 6 -! - xxlsgn = log(sginin) - xxlsga = log(sginia) - xxlsgc = log(sginic) - l2sginin = xxlsgn**2 - l2sginia = xxlsga**2 - l2sginic = xxlsgc**2 - en1 = exp(0.125*l2sginin) - ea1 = exp(0.125*l2sginia) - ec1 = exp(0.125*l2sginic) - esn04 = en1**4 - esa04 = ea1**4 - esc04 = ec1**4 - esn08 = esn04*esn04 - esa08 = esa04*esa04 - esc08 = esc04*esc04 - esn16 = esn08*esn08 - esa16 = esa08*esa08 - esc16 = esc08*esc08 - esn20 = esn16*esn04 - esa20 = esa16*esa04 - esc20 = esc16*esc04 - esn36 = esn16*esn20 - esa36 = esa16*esa20 - esc36 = esc16*esc20 -! First step in WRF-Chem is to add together the aitken, accumulation, and coarse modes -! Calculate number densities - nblk(vnu0) = max(conmin,0.0) - nblk(vnu3) = max(conmin,0.0) - nblk(vac0) = max(conmin, (cblk(1)/rhosmoke + cblk(2)/rhodust)*fact_wfa) - nblk(vcorn) = max(conmin, cblk(3)/rhodust*fact_wfa) - nblk(vac3) = max(conmin,smokefac*cblk(2) + dustfac*cblk(1)) ! Accumulation is smoke + fine dust - nblk(vcor3) = max(conmin,dustfac*cblk(3)) -! Dust in coarse - pmassn = max(conmin,0.0) - pmassa = max(conmin,cblk(1) + cblk(2)) - pmassc = max(conmin,cblk(3)) - pdensn = max(conmin,0.0) - pdensa = max(densmin,(f6dpim9*pmassa/nblk(vac3))) - pdensc = max(densmin,(f6dpim9*pmassc/nblk(vcor3))) -! Calculate mean free path - xlm = 6.6328E-8*pss0*blkta/(tss0*blkprs*1.e3) -! Calculate diameters - dgnuc = max(dgmin,0.0) - dgacc = max(dgmin,(nblk(vac3)/(nblk(vac0)*esa36))**one3) - dgcor = max(dgmin,(nblk(vcor3)/(nblk(vcorn)*esc36))**one3) -! Calculate Knudsen numbers - knnuc = 2.0*xlm/dgnuc - knacc = 2.0*xlm/dgacc - kncor = 2.0*xlm/dgcor -end subroutine modpar ! !-------------------------------------------------------------------------------- ! diff --git a/physics/smoke_dust/dep_dry_simple_mod.F90 b/physics/smoke_dust/dep_dry_simple_mod.F90 index 91e2997c5..e47d3d974 100755 --- a/physics/smoke_dust/dep_dry_simple_mod.F90 +++ b/physics/smoke_dust/dep_dry_simple_mod.F90 @@ -26,8 +26,6 @@ subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(INOUT) :: ust, rmol -! REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & -! INTENT(IN ) :: rel_hum REAL(kind_phys), PARAMETER :: kpart=500. REAL(kind_phys) :: dvpart @@ -56,9 +54,6 @@ subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & dvpart = dvpart*(1.+(-300.*rmol(i,j))**0.66667) ENDIF -! IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION -! dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) -! END IF ddvel(i,j,nv) = MIN(0.50,dvpart) ! m/s enddo enddo diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 3902d6508..54e66712d 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -140,9 +140,6 @@ subroutine gocart_dust_fengsha_driver(dt, & endif ! limit where there is lots of vegetation - !if (sum(vegfra(i,:,j)) .gt. .17) then - ! ilwi = 0 - !endif ! limit where there is snow on the ground if (snowh(i,j) .gt. 0) then diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 70c14c54c..95005b973 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -17,9 +17,9 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & IMPLICIT NONE - INTEGER, INTENT(IN ) :: julday, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & + INTEGER, INTENT(IN ) :: julday, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & @@ -49,14 +49,14 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation ! For Gaussian diurnal cycle - REAL, PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later - REAL, PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & - coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. + real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later + real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & + coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. !>-- Fire parameters - real(kind=kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) - real(kind=kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) + real(kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) + real(kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) - timeq= gmt*3600. + real(time_int,4) + timeq= gmt*3600._kind_phys + real(time_int,4) timeq= mod(timeq,timeq_max) @@ -94,28 +94,26 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) - ! these fires will have exponentially decreasing diurnal cycle, - ! these fires decrease 55% in 2 hours, end in 5 hours - ! r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) - ! We assume 1hr latency in ingesting the sat. data - coef_bb_dc(i,j) = 1./((2*pi)**0.5 * sigma_fire_dur(1) *fire_age) * & + ! these fires will have exponentially decreasing diurnal cycle, + ! We assume 1hr latency in ingesting the sat. data + coef_bb_dc(i,j) = 1._kind_phys/((2*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) CASE (3) - age_hr= fire_age/3600. + age_hr= fire_age/3600._kind_phys IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN - fhist(i,j)= 0.75 + fhist(i,j)= 0.75_kind_phys ENDIF IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN - fhist(i,j)= 0.5 + fhist(i,j)= 0.5_kind_phys ENDIF IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN - fhist(i,j)= 0.25 + fhist(i,j)= 0.25_kind_phys ENDIF ! this is based on hwp, hourly or instantenous TBD - dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1.,hwp_prevd(i,j)) - dc_hwp= MAX(0.,dc_hwp) + dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1._kind_phys,hwp_prevd(i,j)) + dc_hwp= MAX(0._kind_phys,dc_hwp) !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( !hwp_(i,j)/ hwp_day_avg(i,j))) @@ -124,33 +122,39 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dt1= abs(timeq - peak_hr(i,j)) dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. dtm= MIN(dt1,dt2) - dc_gp = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) - dc_gp = MAX(0.,dc_gp) + dc_gp = rinti*( ax2 * exp(- dtm**2/(2._kind_phys*cx2**2) ) + const2 - coef2*timeq ) + dc_gp = MAX(0._kind_phys,dc_gp) - dc_fn = MAX(dc_hwp/dc_gp,3.) - coef_bb_dc(i,j) = sc_factor* fhist(i,j)* dc_fn - - do k=kts,kfire_max - conv= coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) - - dm_smoke= conv*ebu(i,k,j) - ! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) - - chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) - - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif - enddo + dc_fn = MAX(dc_hwp/dc_gp,3._kind_phys) + coef_bb_dc(i,j) = fhist(i,j)* dc_fn CASE DEFAULT END SELECT enddo enddo endif + do j=jts,jte + do i=its,ite + do k=kts,kfire_max + if (ebb_dcycle==1) then + conv= dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + elseif (ebb_dcycle==2) then + conv= sc_factor*coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + endif + dm_smoke= conv*ebu(i,k,j) + chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke + chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then + WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k + WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv',rho_phy(i,k,j),dz8w(i,k,j),conv + WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke + endif + enddo + enddo + enddo + + END subroutine add_emis_burn END module module_add_emiss_burn diff --git a/physics/smoke_dust/module_plumerise.F90 b/physics/smoke_dust/module_plumerise.F90 new file mode 100755 index 000000000..8a1d6ab25 --- /dev/null +++ b/physics/smoke_dust/module_plumerise.F90 @@ -0,0 +1,172 @@ +!>\file module_plumerise.F90 +!! This file is the fire plume rise driver. + + module module_plumerise + + use machine , only : kind_phys +! real(kind=kind_phys),parameter :: p1000mb = 100000. ! p at 1000mb (pascals) +!- Implementing the fire radiative power (FRP) methodology for biomass burning +!- emissions and convective energy estimation. +!- Saulo Freitas, Gabriel Pereira (INPE/UFJS, Brazil) +!- Ravan Ahmadov, Georg Grell (NOAA, USA) +!- The flag "plumerise_flag" defines the method: +!- =1 => original method +!- =2 => FRP based + +CONTAINS +subroutine ebu_driver ( flam_frac,ebu_in,ebu, & + theta_phy,q_vap, & ! RAR: moist is replaced with q_vap, SRB: t_phy is repalced by theta_phy + rho_phy,vvel,u_phy,v_phy,pi_phy, & ! SRB: p_phy is replaced by pi_phy + wind_phy, & ! SRB: added wind_phy + z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags + frp_inst, k_min, k_max, & ! RAR: + wind_eff_opt, & + kpbl_thetav, & ! SRB: added kpbl_thetav + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, errmsg, errflg) + + use rrfs_smoke_config + use plume_data_mod + USE module_zero_plumegen_coms + USE module_smoke_plumerise + IMPLICIT NONE + + REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to distribute smoke in PBL + + REAL(kind_phys), PARAMETER :: zpbl_threshold = 2000. ! SRB: Minimum PBL depth to have plume rise + REAL(kind_phys), PARAMETER :: uspd_threshold = 5. ! SRB: Wind speed averaged across PBL depth to control smoke release levels + REAL(kind_phys), PARAMETER :: frp_threshold500 = 500.e+6 ! SRB: Minimum FRP (Watts) to have plume rise + + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_inst ! RAR: FRP array + + real(kind_phys), DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl_thetav ! SRB + + character(*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN ) :: wind_eff_opt + real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu + real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: z,z_at_w,vvel,u_phy,v_phy,rho_phy,pi_phy,q_vap,theta_phy,wind_phy ! RAR, SRB + +! Local variables... + INTEGER :: nv, i, j, k, kp1, kp2 + INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread + real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev, uspd ! SRB + real(kind=kind_phys) :: dz_plume, cpor, con_rocp, uspdavg ! SRB + + cpor =con_cp/con_rd + con_rocp=con_rd/con_cp + + IF ( dbg_opt ) then + WRITE(*,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte + WRITE(*,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme + WRITE(*,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) + END IF + +! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated + !do nv=1,num_ebu + do j=jts,jte + do k=kts+1,kte + do i=its,ite + ebu(i,k,j)=0. + enddo + enddo + enddo + !enddo + +! For now the flammable fraction is constant, based on the namelist. The next +! step to use LU index and meteorology to parameterize it + do j=jts,jte + do i=its,ite + flam_frac(i,j)= 0. + if (frp_inst(i,j) > frp_threshold) then + flam_frac(i,j)= 0.9 + end if + enddo + enddo + + +! RAR: new FRP based approach +! Haiqin: do_plumerise is added to the namelist options +check_pl: IF (do_plumerise) THEN ! if the namelist option is set for plumerise + do j=jts,jte + do i=its,ite + + do k=kts,kte + u_in(k)= u_phy(i,k,j) + v_in(k)= v_phy(i,k,j) + w_in(k)= vvel(i,k,j) + qv_in(k)= q_vap(i,k,j) + pi_in(k)= pi_phy(i,k,j) + zmid(k)= z(i,k,j)-z_at_w(i,kts,j) + z_lev(k)= z_at_w(i,k,j)-z_at_w(i,kts,j) + rho_phyin(k)= rho_phy(i,k,j) + theta_in(k)= theta_phy(i,k,j) + uspd(k)= wind_phy(i,k,j) ! SRB + enddo + + IF (dbg_opt) then + WRITE(*,*) 'module_plumerise: i,j ',i,j + WRITE(*,*) 'module_plumerise: frp_inst(i,j) ',frp_inst(i,j) + WRITE(*,*) 'module_plumerise: ebu(i,kts,j) ',ebu(i,kts,j) + WRITE(*,*) 'module_plumerise: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) + WRITE(*,*) 'module_plumerise: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) + END IF + +! RAR: the plume rise calculation step: + CALL plumerise(kte,1,1,1,1,1,1, & + u_in, v_in, w_in, theta_in ,pi_in, & + rho_phyin, qv_in, zmid, z_lev, & + wind_eff_opt, & + frp_inst(i,j), k_min(i,j), & + k_max(i,j), dbg_opt, g, con_cp, & + con_rd, cpor, errmsg, errflg ) + if(errflg/=0) return + + kp1= k_min(i,j) + kp2= k_max(i,j) + dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) + +! SRB: Adding condition for overwriting plumerise levels + uspdavg=SUM(uspd(kts:kpbl_thetav(i,j)))/kpbl_thetav(i,j) !Average wind speed within the boundary layer + + IF ((frp_inst(i,j) .gt. frp_threshold) .AND. (frp_inst(i,j) .le. frp_threshold500) .AND. & + (z_at_w(i,kpbl_thetav(i,j),j) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN + kp1=1 + IF (uspdavg .ge. uspd_threshold) THEN ! Too windy + kp2=kpbl_thetav(i,j)/3 + ELSE + kp2=kpbl_thetav(i,j) + END IF + dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) + do k=kp1,kp2-1 + ebu(i,k,j)= ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + enddo + ELSE + do k=kp1,kp2-1 + ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + enddo + ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) + END IF +! SRB: End modification + + IF ( dbg_opt ) then + WRITE(*,*) 'module_plumerise: i,j ',i,j + WRITE(*,*) 'module_plumerise: k_min(i,j), k_max(i,j) ',kp1, kp2 ! SRB: replaced k_min, k_max with kp1, kp2 + END IF +! endif check_frp + enddo + enddo + + ENDIF check_pl + +end subroutine ebu_driver + +END module module_plumerise diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 deleted file mode 100755 index f98350130..000000000 --- a/physics/smoke_dust/module_plumerise1.F90 +++ /dev/null @@ -1,225 +0,0 @@ -!>\file module_plumerise1.F90 -!! This file is the fire plume rise driver. - - module module_plumerise1 - - use machine , only : kind_phys - real(kind=kind_phys),parameter :: p1000mb = 100000. ! p at 1000mb (pascals) -!- Implementing the fire radiative power (FRP) methodology for biomass burning -!- emissions and convective energy estimation. -!- Saulo Freitas, Gabriel Pereira (INPE/UFJS, Brazil) -!- Ravan Ahmadov, Georg Grell (NOAA, USA) -!- The flag "plumerise_flag" defines the method: -!- =1 => original method -!- =2 => FRP based -!------------------------------------------------------------------------- -! -! use module_zero_plumegen_coms -! integer, parameter :: nveg_agreg = 4 -! integer, parameter :: tropical_forest = 1 -! integer, parameter :: boreal_forest = 2 -! integer, parameter :: savannah = 3 - -! integer, parameter :: grassland = 4 -! real(kind_phys), dimension(nveg_agreg) :: firesize,mean_fct -! character(len=20), parameter :: veg_name(nveg_agreg) = (/ & -! 'Tropical-Forest', & -! 'Boreal-Forest ', & -! 'Savanna ', & -! 'Grassland ' /) -! character(len=20), parameter :: spc_suf(nveg_agreg) = (/ & -! 'agtf' , & ! trop forest -! 'agef' , & ! extratrop forest -! 'agsv' , & ! savanna -! 'aggr' /) ! grassland - -CONTAINS -subroutine ebu_driver ( flam_frac,ebu_in,ebu,coef_bb_dc, & - t_phy,q_vap, & ! RAR: moist is replaced with q_vap - rho_phy,vvel,u_phy,v_phy,p_phy, & - z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - frp_hr, k_min, k_max, & ! RAR: - wind_eff_opt, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg) - - use rrfs_smoke_config - use plume_data_mod - USE module_zero_plumegen_coms - USE module_smoke_plumerise - IMPLICIT NONE - - REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to have plume rise - - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_hr ! RAR: FRP array - -! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - character(*), intent(inout) :: errmsg - integer, intent(inout) :: errflg - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - INTEGER, INTENT(IN ) :: wind_eff_opt -! real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), & -! INTENT(IN ) :: moist - real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: coef_bb_dc ! RAR: - real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ) :: frp_hr_coef_bb_dc - -! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & -! INTENT(IN ) :: ebu_in -! real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), & -! INTENT(IN ) :: & -! mean_fct_agtf,mean_fct_agef,& -! mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, & -! firesize_agsv,firesize_aggr - - real(kind=kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: t_phy,z,z_at_w,vvel,u_phy,v_phy,rho_phy,p_phy,q_vap ! RAR - ! real(kind=kind_phys), INTENT(IN ) :: dtstep - -! Local variables... - INTEGER :: nv, i, j, k, kp1, kp2 - INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread - !real(kind_phys), dimension (num_ebu) :: eburn_in - !real(kind_phys), dimension (kte,num_ebu) :: eburn_out - real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev - real(kind=kind_phys) :: dz_plume, cpor, con_rocp - - !INTEGER, PARAMETER :: kfire_max=30 -! real(kind_phys), dimension(nveg_agreg) :: firesize,mean_fct -! real(kind_phys) :: sum, ffirs, ratio -! real(kind_phys),save,dimension(its:ite,jts:jte) :: ffirs -! nspecies=num_ebu -! write(0,*)'plumerise' - -! RAR: -! do j=jts,jte: -! do i=its,ite -! ebu(i,kts,j,p_ebu_smoke)= ebb_smoke(i,j) -! ebu(i,kts,j,p_ebu_no) = ebu_in(i,1,j,p_ebu_in_no) -! ebu(i,kts,j,p_ebu_co) = ebu_in(i,1,j,p_ebu_in_co) -! ebu(i,kts,j,p_ebu_so2) = ebu_in(i,1,j,p_ebu_in_so2) -! ebu(i,kts,j,p_ebu_dms) = ebu_in(i,1,j,p_ebu_in_dms) -! ebu(i,kts,j,p_ebu_oc) = ebu_in(i,1,j,p_ebu_in_oc) -! ebu(i,kts,j,p_ebu_bc) = ebu_in(i,1,j,p_ebu_in_bc) -! ebu(i,kts,j,p_ebu_pm25) = ebu_in(i,1,j,p_ebu_in_pm25) -! ebu(i,kts,j,p_ebu_pm10) = ebu_in(i,1,j,p_ebu_in_pm10) -! enddo -! enddo - cpor =con_cp/con_rd - con_rocp=con_rd/con_cp - - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise1: its,ite,jts,jte ', its,ite,jts,jte - WRITE(*,*) 'module_plumerise1: ims,ime,jms,jme ', ims,ime,jms,jme - !WRITE(*,*) 'module_plumerise1: p_ebu_smoke,num_ebu: ', p_ebu_smoke,num_ebu - WRITE(*,*) 'module_plumerise1: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) - END IF - !endif - -! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated - !do nv=1,num_ebu - do j=jts,jte - do k=kts+1,kte - do i=its,ite - ebu(i,k,j)=0. - enddo - enddo - enddo - !enddo - -! Apply the diurnal cycle coefficient - do j=jts,jte - do i=its,ite - frp_hr_coef_bb_dc(i,j) = frp_hr(i,j)*coef_bb_dc(i,j) - enddo - enddo - -! For now the flammable fraction is constant, based on the namelist. The next -! step to use LU index and meteorology to parameterize it - do j=jts,jte - do i=its,ite - flam_frac(i,j)= 0. - if (frp_hr_coef_bb_dc(i,j) > frp_threshold) then - flam_frac(i,j)= 0.9 - end if - enddo - enddo - - -! RAR: new FRP based approach -!check_pl: IF (config_flags%plumerise_flag == 2 ) THEN ! if the namelist option is set for plumerise -! Haiqin: plumerise_flag is added to the namelist options -check_pl: IF (do_plumerise) THEN ! if the namelist option is set for plumerise - do j=jts,jte - do i=its,ite - ! k_min(i,j)=0 - ! k_max(i,j)=0 - -! check_frp: if (.NOT.do_plumerise) then ! namelist option -! ebu(i,kts,j)= ebb_smoke(i,j) -! else - - do k=kts,kte - u_in(k)= u_phy(i,k,j) - v_in(k)= v_phy(i,k,j) - w_in(k)= vvel(i,k,j) - qv_in(k)= q_vap(i,k,j) ! RAR: moist(i,k,j,p_qv) - !pi_in(k)= cp*(p_phy(i,k,j)/p1000mb)**rcp - pi_in(k)= con_cp*(p_phy(i,k,j)/p1000mb)**con_rocp - zmid(k)= z(i,k,j)-z_at_w(i,kts,j) - z_lev(k)= z_at_w(i,k,j)-z_at_w(i,kts,j) - rho_phyin(k)= rho_phy(i,k,j) - theta_in(k)= t_phy(i,k,j)/pi_in(k)*con_cp - !theta_in(k)= t_phy(i,k,j)/pi_in(k)*cp - enddo - - IF (dbg_opt) then - WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: frp_hr(i,j) ',frp_hr_coef_bb_dc(i,j) - WRITE(*,*) 'module_plumerise1: ebu(i,kts,j) ',ebu(i,kts,j) - WRITE(*,*) 'module_plumerise1: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) - WRITE(*,*) 'module_plumerise1: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) - WRITE(*,*) 'module_plumerise1: t_phy(i,kte,j),pi_in(kte)',t_phy(i,kte,j),pi_in(kte) - END IF - -! RAR: the plume rise calculation step: - CALL plumerise(kte,1,1,1,1,1,1, & - !firesize,mean_fct, & - !num_ebu, eburn_in, eburn_out, & - u_in, v_in, w_in, theta_in ,pi_in, & - rho_phyin, qv_in, zmid, z_lev, & - wind_eff_opt, & - frp_hr_coef_bb_dc(i,j), k_min(i,j), & - k_max(i,j), dbg_opt, g, con_cp, & - con_rd, cpor, errmsg, errflg ) - !k_max(i,j), config_flags%debug_chem ) - if(errflg/=0) return - - kp1= k_min(i,j) - kp2= k_max(i,j) - dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) - - do k=kp1,kp2-1 - ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume - enddo - ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) - - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: k_min(i,j), k_max(i,j) ',k_min(i,j), k_max(i,j) - END IF -! endif check_frp - enddo - enddo - - ENDIF check_pl - -end subroutine ebu_driver - -END module module_plumerise1 diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index d80eaeb62..0fca91de4 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -24,9 +24,7 @@ module module_smoke_plumerise CONTAINS ! RAR: - subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & -! firesize,mean_fct, & - ! nspecies,eburn_in,eburn_out, & + subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index b9d52cb49..8ba8f67d9 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -32,6 +32,9 @@ subroutine wetdep_ls(dt,var,rain,moist, integer :: nv,i,j,k,km,kb,kbeg !real(kind_phys), parameter :: alpha = .5 ! scavenging factor + wetdpr_smoke =0. + wetdpr_dust =0. + wetdpr_coarsepm=0. do nv=1,nchem do i=its,ite diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 index 2bf91dbfa..3f0bcdecd 100755 --- a/physics/smoke_dust/plume_data_mod.F90 +++ b/physics/smoke_dust/plume_data_mod.F90 @@ -45,7 +45,6 @@ module plume_data_mod integer, parameter :: savannah = 3 integer, parameter :: grassland = 4 integer, parameter :: nveg_agreg = 4 -! integer, parameter :: wind_eff = 1 public diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index 5f8f02e7b..d7478986b 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -31,6 +31,7 @@ module rrfs_smoke_config integer :: ebb_dcycle = 2 ! 1: read in ebb_smoke(i,24), 2: daily logical :: dbg_opt = .true. logical :: aero_ind_fdb = .false. + logical :: add_fire_heat_flux= .false. logical :: do_rrfs_sd = .true. ! integer :: wind_eff_opt = 1 logical :: extended_sd_diags = .false. @@ -40,8 +41,6 @@ module rrfs_smoke_config integer, parameter :: CHEM_OPT_GOCART= 1 integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 - integer, parameter :: DUST_OPT_FENGSHA = 5 - ! -- hydrometeors integer, parameter :: p_qv=1 integer, parameter :: p_qc=2 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 5f8ca2a8e..392a6ea6b 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index f4e28be3a..afd386595 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -9,9 +9,9 @@ module rrfs_smoke_wrapper addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & drydep_opt, pm_settling, aero_ind_fdb, ebb_dcycle, & dbg_opt,smoke_forecast,wetdep_ls_alpha,do_rrfs_sd, & - ebb_dcycle, extended_sd_diags, & + ebb_dcycle, extended_sd_diags,add_fire_heat_flux, & num_moist, num_chem, num_emis_seas, num_emis_dust, & - DUST_OPT_FENGSHA, p_qv, p_atm_shum, p_atm_cldq, & + p_qv, p_atm_shum, p_atm_cldq, & p_smoke, p_dust_1, p_coarse_pm, epsilc use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor @@ -20,7 +20,7 @@ module rrfs_smoke_wrapper use dep_dry_simple_mod, only : dry_dep_driver_simple use dep_dry_emerson_mod, only : dry_dep_driver_emerson use module_wetdep_ls, only : wetdep_ls - use module_plumerise1, only : ebu_driver + use module_plumerise, only : ebu_driver use module_add_emiss_burn, only : add_emis_burn use coarsepm_settling_mod, only : coarsepm_settling_driver @@ -30,7 +30,7 @@ module rrfs_smoke_wrapper public :: rrfs_smoke_wrapper_run, rrfs_smoke_wrapper_init - integer :: wind_eff_opt + integer :: plume_wind_eff contains @@ -45,7 +45,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, drydep_opt_in, pm_settling_in, & ! Dry Dep namelist wetdep_ls_opt_in,wetdep_ls_alpha_in, & ! Wet dep namelist rrfs_sd, do_plumerise_in, plumerisefire_frq_in, & ! smoke namelist - wind_eff_opt_in, & ! smoke namelist + plume_wind_eff_in,add_fire_heat_flux_in, & ! smoke namelist addsmoke_flag_in, ebb_dcycle_in, smoke_forecast_in, & ! Smoke namelist dust_opt_in, dust_alpha_in, dust_gamma_in, & ! Dust namelist dust_moist_opt_in, & ! Dust namelist @@ -61,8 +61,8 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, real(kind_phys), intent(in) :: dust_drylimit_factor_in integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in integer, intent(in) :: drydep_opt_in - logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in - integer, intent(in) :: smoke_forecast_in, wind_eff_opt_in, plumerisefire_frq_in + logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in, add_fire_heat_flux_in + integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in logical, intent(in) :: do_plumerise_in, rrfs_sd character(len=*),intent(out):: errmsg @@ -93,7 +93,8 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, plumerisefire_frq = plumerisefire_frq_in addsmoke_flag = addsmoke_flag_in smoke_forecast = smoke_forecast_in - wind_eff_opt = wind_eff_opt_in + plume_wind_eff = plume_wind_eff_in + add_fire_heat_flux = add_fire_heat_flux_in !>-Feedback aero_ind_fdb = aero_ind_fdb_in !>-Other @@ -110,14 +111,14 @@ end subroutine rrfs_smoke_wrapper_init subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype_dom, vegtype_frac,soiltyp,nlcat, & + nsoil, smc, vegtype_dom, vegtype_frac, soiltyp, nlcat, & dswsfc, zorl, snow, julian,recmol, & idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & - ebb_smoke_in, frp_input, coef_bb, ebu_smoke,fhist,min_fplume, & + ebb_smoke_in, frp_output, coef_bb, ebu_smoke,fhist,min_fplume, & max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & errmsg,errflg ) @@ -148,7 +149,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:,:,:), intent(inout) :: qgrs, gq0 real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc - real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_input, fhist + real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_output, fhist real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke real(kind_phys), dimension(:,:), intent(inout) :: fire_in real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out @@ -169,8 +170,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>-- Local Variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: ebu real(kind_phys), dimension(1:im, 1:kme,jms:jme) :: rri, t_phy, u_phy, v_phy, & - p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid - real(kind_phys), dimension(ims:im, jms:jme) :: u10, v10, ust, tsk, & + p_phy,pi_phy,wind_phy,theta_phy,z_at_w, dz8w, p8w, t8w, & + rho_phy, vvel, zmid + real(kind_phys), dimension(ims:im, jms:jme) :: frp_inst, u10, v10, ust, tsk, & xland, xlat, xlong, dxy, pbl, hfx, rnav, hwp_local, & wetdpr_smoke_local, wetdpr_dust_local, wetdpr_coarsepm_local !>- sea salt & chemistry variables @@ -183,8 +185,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys) :: gmt !>- dust & chemistry variables real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust - real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf + real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp @@ -192,9 +194,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- buffers real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & - fire_end_hr, hwp_day_avg + fire_end_hr, hwp_day_avg, kpbl_thetav integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type - logical :: call_fire, reset_hwp_ave + logical :: call_plume, reset_hwp_ave !>- optical variables real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav @@ -204,8 +206,6 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !> -- parameter to caluclate wfa&ifa (m) real(kind_phys), parameter :: mean_diameter1= 4.E-8, sigma1=1.8 real(kind_phys), parameter :: mean_diameter2= 1.E-6, sigma2=1.8 - ! real(kind_phys), parameter :: kappa_oc = 0.2 - ! real(kind_phys), parameter :: kappa_dust = 0.04 real(kind_phys) :: fact_wfa, fact_ifa !> -- aerosol density (kg/m3) real(kind_phys), parameter :: density_dust= 2.6e+3, density_sulfate=1.8e+3 @@ -247,7 +247,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, curr_secs = ktau * dt current_month=jdate(2) ! needed for the dust input data current_hour =jdate(5)+1 ! =1 at 00Z - hour_int=ktau*dt/3600. ! hours since the simulation start + hour_int=floor(ktau*dt/3600.) ! hours since the simulation start gmt = real(mod(idat(5)+hour_int,24)) julday = int(julian) @@ -268,25 +268,25 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 ! plumerise frequency in minutes set up by the namelist input - call_fire = (do_plumerise .and. (plumerisefire_frq > 0)) - if (call_fire) call_fire = (mod(int(curr_secs), max(1, 60*plumerisefire_frq)) == 0) .or. (ktau == 2) + call_plume = (do_plumerise .and. (plumerisefire_frq > 0)) + if (call_plume) call_plume = (mod(int(curr_secs), max(1, 60*plumerisefire_frq)) == 0) .or. (ktau == 2) !>- get ready for chemistry run call rrfs_smoke_prep( & - ktau,current_month, current_hour, gmt, con_rd, con_fv, & + ktau,current_month, current_hour, gmt, con_rd, con_fv, con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,recmol, & + rri,t_phy,u_phy,v_phy,p_phy,pi_phy,wind_phy,theta_phy, & + rho_phy,dz8w,p8w,t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & - moist,chem,ebu_in,ebb_smoke_in, & + moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & fhist,frp_in, hwp_day_avg, fire_end_hr, & emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & @@ -315,15 +315,16 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag ! or urban fires, 2- prescribed fires in wooded area, 3- wildfires + if (ebb_dcycle==2) then do j=jts,jte do i=its,ite if (ebu_in(i,j)<0.01) then fire_type(i,j) = 0 else ! Permanent wetlands, snow/ice, water, barren tundra - lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) + lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) ! cropland, urban, cropland/natural mosaic, barren and sparsely vegetated - lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) + lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) if (lu_nofire(i,j)>0.95) then fire_type(i,j) = 0 else if (lu_qfire(i,j)>0.95) then @@ -334,6 +335,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end if end do end do + endif !>- compute sea-salt ! -- compute sea salt (opt=1) @@ -348,7 +350,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif !-- compute dust (opt=5) - if (dust_opt==DUST_OPT_FENGSHA) then + if (dust_opt==5) then call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & @@ -364,9 +366,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- /scratch2/BMC/ap-fc/Ravan/rapid-refresh/WRFV3.9/smoke ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag - !if (add_fire_heat_flux) then - do i = its,ite - if ( frp_in(i,1) .ge. 1.E7 ) then + if (add_fire_heat_flux) then + do i = its,ite + if ( coef_bb_dc(i,1)*frp_in(i,1) .ge. 1.E7 ) then fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & 0.55/dxy(i,1)) ,5000.) ! JLS - W m-2 [0 - 10,000] frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*coef_bb_dc(i,1)*frp_in(i,1)/dxy(i,1) ),1.) @@ -374,17 +376,24 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, fire_heat_flux_out(i) = 0.0 frac_grid_burned_out(i) = 0.0 endif - enddo - !endif - if (call_fire) then + enddo + endif + if (call_plume) then + ! Apply the diurnal cycle coefficient to frp_inst () + do j=jts,jte + do i=its,ite + frp_inst(i,j) = frp_in(i,j)*coef_bb_dc(i,j) + enddo + enddo + call ebu_driver ( & flam_frac,ebu_in,ebu, & - coef_bb_dc, & - t_phy,moist(:,:,:,p_qv), & - rho_phy,vvel,u_phy,v_phy,p_phy, & + theta_phy,moist(:,:,:,p_qv), & + rho_phy,vvel,u_phy,v_phy,pi_phy,wind_phy, & z_at_w,zmid,g,con_cp,con_rd, & - frp_in, min_fplume2, max_fplume2, & ! new approach - wind_eff_opt, & + frp_inst, min_fplume2, max_fplume2, & + plume_wind_eff, & + kpbl_thetav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) @@ -419,7 +428,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, if (drydep_opt == 1) then call dry_dep_driver_emerson(rmol,ust,znt,ndvel,ddvel, & vgrav,chem,dz8w,snowh,t_phy,p_phy,rho_phy,ivgtyp,g,dt, & - pm_settling,drydep_flux_local,settling_flux, & + pm_settling,drydep_flux_local,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -452,7 +461,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) - if ( extended_sd_diags ) then + if ( extended_sd_diags .or. dbg_opt) then do i = its, ite wetdpr(i,1) = wetdpr(i,1) + wetdpr_smoke_local (i,1) wetdpr(i,2) = wetdpr(i,2) + wetdpr_dust_local (i,1) @@ -479,7 +488,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo !---- diagnostic output of dry deposition & gravitational settling fluxes - if ( drydep_opt == 1 .and. extended_sd_diags ) then + if ( drydep_opt == 1 .and. (extended_sd_diags .or. dbg_opt) ) then do nv = 1, ndvel do i=its,ite drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & @@ -511,12 +520,12 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im - !emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s - !emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s + emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & emis_dust(i,1,1,3) + emis_dust(i,1,1,4) ! dust emission: ug/m2/s coef_bb (i) = coef_bb_dc(i,1) - frp_input (i) = coef_bb_dc(i,1)*frp_in(i,1) + frp_output (i) = coef_bb_dc(i,1)*frp_in(i,1) fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) @@ -556,20 +565,20 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end subroutine rrfs_smoke_wrapper_run subroutine rrfs_smoke_prep( & - ktau,current_month,current_hour,gmt,con_rd,con_fv, & + ktau,current_month,current_hour,gmt,con_rd,con_fv,con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,recmol, & + rri,t_phy,u_phy,v_phy,p_phy,pi_phy,wind_phy,theta_phy, & + rho_phy,dz8w,p8w,t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem, num_moist, & ntsmoke, ntdust, ntcoarsepm, & - moist,chem,ebu_in,ebb_smoke_in, & + moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & fhist,frp_in, hwp_day_avg, fire_end_hr, & emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & @@ -585,7 +594,7 @@ subroutine rrfs_smoke_prep( & integer, intent(in) :: nsoil, ktau integer, dimension(ims:ime), intent(in) :: land, vegtype_dom, soiltyp, kpbl integer, intent(in) :: ntrac - real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv + real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv, con_cp real(kind=kind_phys), dimension(ims:ime), intent(in) :: & u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol @@ -596,7 +605,7 @@ subroutine rrfs_smoke_prep( & ! This is a place holder for ebb_dcycle == 2, currently set to hold a single ! value, which is the previous day's average of hwp, frp, ebb, fire_end real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: smoke2d_RRFS - real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: emi_ant_in + real(kind=kind_phys), dimension(ims:ime, 1), intent(in) :: emi_ant_in real(kind=kind_phys), dimension(ims:ime, kms:kme), intent(in) :: pr3d,ph3d real(kind=kind_phys), dimension(ims:ime, kts:kte), intent(in) :: & phl3d,tk3d,prl3d,us3d,vs3d,spechum,w @@ -611,12 +620,11 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, jms:jme),intent(out) :: ebu_in - ! real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp integer,dimension(ims:ime, jms:jme), intent(out) :: isltyp, ivgtyp real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: & rri, t_phy, u_phy, v_phy, p_phy, rho_phy, dz8w, p8w, t8w, vvel, & - zmid + zmid, pi_phy, theta_phy, wind_phy real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: & u10, v10, ust, tsk, xland, xlat, xlong, dxy, rmol, swdown, znt, & pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr, hwp_local @@ -629,16 +637,17 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in - ! real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W - real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) + real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) ! -- local variables integer i,ip,j,k,k1,kp,kk,kkp,nv,l,ll,n,nl - real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA,ZSF + real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA real(kind_phys), dimension(ims:ime, kms:kme, jms:jme) :: THETAV - real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot,kpbl_thetav + real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot + real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: kpbl_thetav real(kind_phys), parameter :: delta_theta4gust = 0.5 + real(kind=kind_phys),parameter :: p1000mb = 100000. ! -- initialize fire emissions ebu_in = 0._kind_phys @@ -653,9 +662,12 @@ subroutine rrfs_smoke_prep( & ivgtyp = 0._kind_phys rri = 0._kind_phys t_phy = 0._kind_phys + theta_phy = 0._kind_phys u_phy = 0._kind_phys v_phy = 0._kind_phys + wind_phy = 0._kind_phys p_phy = 0._kind_phys + pi_phy = 0._kind_phys rho_phy = 0._kind_phys dz8w = 0._kind_phys p8w = 0._kind_phys @@ -755,6 +767,9 @@ subroutine rrfs_smoke_prep( & p_phy(i,k,j)=prl3d(i,kkp) u_phy(i,k,j)=us3d(i,kkp) v_phy(i,k,j)=vs3d(i,kkp) + pi_phy(i,k,j) = con_cp*(p_phy(i,k,j)/p1000mb)**(con_rd/con_cp) + theta_phy(i,k,j) = t_phy(i,k,j)/pi_phy(i,k,j)*con_cp + wind_phy(i,k,j) = sqrt(u_phy(i,k,j)**2 + v_phy(i,k,j)**2) ! from mp_thompson.F90 ; rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) ! from mynnd rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) !*(1.+con_fv*spechum(i,kkp))) @@ -764,14 +779,9 @@ subroutine rrfs_smoke_prep( & moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) if (t_phy(i,k,j) > 265.) then moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) - !moist(i,k,j,3)=0. - ! TODO -- should we keep these limits? if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. else moist(i,k,j,2)=0. - ! moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) - ! TODO -- should we keep these limits? - ! if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. endif !-- zmid(i,k,j)=phl3d(i,kkp)/g @@ -813,7 +823,6 @@ subroutine rrfs_smoke_prep( & do i = its, ite do j = jts, jte if ( THETAV(i,kts+1,j) .lt. ( THETAV(i,kts,j) + delta_theta4gust) ) then - ZSF = oro(i) do k = kts+1, kte k1 = k !--- give theta-v at the sfc a 0.5K boost in the PBLH definition @@ -822,12 +831,7 @@ subroutine rrfs_smoke_prep( & endif enddo kpbl_thetav(i,j) = k1 - !pblh_thetav(i,j) = zmid(i,k+k1-1,j) * & - ! ((THETAV(i,kts,j)+delta_theta4gust) - THETAV(i,kts+k1-1,j)) & - ! * (zmid(i,kts+k1-1,j) - zmid(i,kts+k1-2,j)) & - ! / (THETAV(i,kts+k1-1,j) - THETAV(i,kts+k1-2,j)) - ZSF else - !pblh_thetav(i,j) = 0.0 kpbl_thetav(i,j) = kts + 1 endif enddo @@ -838,7 +842,7 @@ subroutine rrfs_smoke_prep( & SFCWIND = sqrt(u10m(i)**2+v10m(i)**2) windgustpot(i,1) = SFCWIND if (kpbl_thetav(i,1)+1 .ge. kts+1 ) then - do k=kts+1,kpbl_thetav(i,1)+1 + do k=kts+1,int(kpbl_thetav(i,1))+1 WIND = sqrt(us3d(i,k)**2+vs3d(i,k)**2) DELWIND = WIND - SFCWIND DZ = zmid(i,k,1) - oro(i) @@ -851,7 +855,6 @@ subroutine rrfs_smoke_prep( & do i=its,ite wdgust=max(windgustpot(i,1),3.) snoweq=max((25.-snow_cpl(i))/25.,0.) - ! hwp_local(i,1)=0.237*wdgust**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq ! Eric original 08/2022 hwp_local(i,1)=0.177*wdgust**0.97*max(t2m(i)-dpt2m(i),15.)**1.03*((1.-wetness(i))**0.4)*snoweq ! Eric update 11/2023 enddo ! Set paramters for ebb_dcycle option @@ -865,10 +868,6 @@ subroutine rrfs_smoke_prep( & fire_end_hr(i,j) = 0.0 hwp_day_avg(i,j) = 0.0 ebb_smoke_in (i) = ebu_in(i,j) - if (ktau == 1) then - fhist (i,j) = 1. - coef_bb_dc (i,j) = 1. - endif enddo enddo endif @@ -876,7 +875,7 @@ subroutine rrfs_smoke_prep( & ! RAR: here we need to initialize various arrays in order to apply HWP to ! diurnal cycle ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal - if (ebb_dcycle == 2) then + if (ebb_dcycle == 2 .and. ktau == 1) then do i=its, ite do j=jts, jte ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. @@ -884,11 +883,6 @@ subroutine rrfs_smoke_prep( & fire_end_hr (i,j) = smoke2d_RRFS(i,3) hwp_day_avg (i,j) = smoke2d_RRFS(i,4) ebb_smoke_in(i ) = ebu_in(i,j) - ! Initialize to 1 on first time step, modified by add_emiss_burn thereafter - if (ktau == 1) then - fhist (i,j) = 1. - coef_bb_dc (i,j) = 1. - endif enddo enddo end if @@ -896,6 +890,8 @@ subroutine rrfs_smoke_prep( & if (ktau==1) then do j=jts,jte do i=its,ite + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. if (xlong(i,j)<230.) then peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska elseif(xlong(i,j)<245.) then diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index fe664d31d..393c5d3d8 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] @@ -50,6 +50,13 @@ dimensions = () type = logical intent = in +[add_fire_heat_flux_in] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical + intent = in [do_plumerise_in] standard_name = do_smoke_plumerise long_name = rrfs smoke plumerise option @@ -64,7 +71,7 @@ dimensions = () type = integer intent = in -[wind_eff_opt_in] +[plume_wind_eff_in] standard_name = option_for_wind_effects_on_smoke_plumerise long_name = wind effect plumerise option units = index @@ -551,7 +558,7 @@ standard_name = anthropogenic_background_input long_name = anthropogenic background input units = various - dimensions = (horizontal_loop_extent,4) + dimensions = (horizontal_loop_extent,1) type = real kind = kind_phys intent = in @@ -567,7 +574,7 @@ standard_name = emission_smoke_prvd_RRFS long_name = emission fire RRFS daily units = various - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -692,7 +699,7 @@ type = real kind = kind_phys intent = inout -[frp_input] +[frp_output] standard_name = frp_hourly long_name = hourly fire radiative power units = MW diff --git a/physics/smoke_dust/seas_mod.F90 b/physics/smoke_dust/seas_mod.F90 index 1d18046ad..e5e63e909 100755 --- a/physics/smoke_dust/seas_mod.F90 +++ b/physics/smoke_dust/seas_mod.F90 @@ -185,7 +185,6 @@ subroutine gocart_seasalt_driver(dt,alt,t_phy,u_phy, & chem(i,kts,j,p_seas_3) = chem(i,kts,j,p_seas_3) + tc(3)*converi chem(i,kts,j,p_seas_4) = chem(i,kts,j,p_seas_4) + tc(4)*converi chem(i,kts,j,p_seas_5) = chem(i,kts,j,p_seas_5) + tc(5)*converi - !print*,'hli tc(2),chem(i,kts,j,p_seas_2)',tc(2),chem(i,kts,j,p_seas_2) ! for output diagnostics emis_seas(i,1,j,p_eseas1) = bems(1) From 846ec8e0075e9e330401e03d5e0880963926d9d7 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 20 Dec 2023 03:08:53 +0000 Subject: [PATCH 110/122] remove extra rho0 --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index a035928f4..91e8c71b7 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -270,7 +270,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, tsfc, & flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: From bf99b986d1a35c24e6fee2a518196ac65788a4c6 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Wed, 20 Dec 2023 17:40:11 +0000 Subject: [PATCH 111/122] "declare nchem as intent in" --- physics/cu_gf_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index e4a78b030..92f8760b0 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -94,8 +94,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: dicycle_m=0 !- diurnal cycle flag integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- - integer :: its,ite, jts,jte, kts,kte, nchem - integer, intent(in ) :: im,km,ntracer + integer :: its,ite, jts,jte, kts,kte + integer, intent(in ) :: im,km,ntracer, nchem integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend From 37d512f55b425ef7f1ff069c89d23d85c7f9bb8e Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 22 Dec 2023 21:17:51 +0000 Subject: [PATCH 112/122] "update the dimension of chem3d in GF for hercules/gnu rap cases" --- physics/cu_gf_deep.F90 | 4 ++-- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index b45452000..a1bca36c9 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -216,11 +216,11 @@ subroutine cu_gf_deep_run( & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) - real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) & + real(kind=kind_phys), dimension (:,:,:) & ,intent (inout) :: & chem3d logical, intent (in) :: do_smoke_transport - real(kind=kind_phys), dimension (its:ite,nchem) & + real(kind=kind_phys), dimension (:,:) & , intent (out) :: wetdpc_deep real(kind=kind_phys), intent (in) :: fscav(:) !$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index afd386595..eb7f83af6 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -875,7 +875,7 @@ subroutine rrfs_smoke_prep( & ! RAR: here we need to initialize various arrays in order to apply HWP to ! diurnal cycle ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal - if (ebb_dcycle == 2 .and. ktau == 1) then + if (ebb_dcycle == 2) then do i=its, ite do j=jts, jte ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. From fe77e06ab907accb3b860857d050f990ba88662d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 8 Jan 2024 11:54:41 -0600 Subject: [PATCH 113/122] move sfc_land to new location --- physics/{ => SFC_Models/Land}/sfc_land.F90 | 0 physics/{ => SFC_Models/Land}/sfc_land.meta | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename physics/{ => SFC_Models/Land}/sfc_land.F90 (100%) rename physics/{ => SFC_Models/Land}/sfc_land.meta (100%) diff --git a/physics/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 similarity index 100% rename from physics/sfc_land.F90 rename to physics/SFC_Models/Land/sfc_land.F90 diff --git a/physics/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta similarity index 100% rename from physics/sfc_land.meta rename to physics/SFC_Models/Land/sfc_land.meta From 09b02350a7526f1eddc0885f8bcb26e9cac5c72d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 8 Jan 2024 11:55:57 -0600 Subject: [PATCH 114/122] fix meta file --- physics/SFC_Models/Land/sfc_land.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta index 493d2a70b..6a4bd8fbe 100644 --- a/physics/SFC_Models/Land/sfc_land.meta +++ b/physics/SFC_Models/Land/sfc_land.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_land type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] From 18616d4344cda61f313086b483ccdc350bf1005e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 8 Jan 2024 17:06:43 -0500 Subject: [PATCH 115/122] established a branch for q MERRA2 bug fixed from RRFS --- physics/MP/Morrison_Gettelman/aerinterp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 4e2dc9047..fcfe29607 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -426,7 +426,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ENDDO else DO k=1, levsaer-1 !! from sfc to toa - IF(prsl(j,L) < aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then + IF(prsl(j,L) <= aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then i1 = k i2 = min(k+1,levsaer) exit From c9460205f6047047025536653e05675749b9d074 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Wed, 17 Jan 2024 15:54:26 +0000 Subject: [PATCH 116/122] fix NSSL MP init issue when initialized from other microphysics schemes --- physics/MP/NSSL/mp_nssl.F90 | 42 ++++++++++++++-- physics/MP/NSSL/mp_nssl.meta | 95 ++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 3 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e79376709..ad1d41090 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -15,6 +15,7 @@ module mp_nssl private logical :: is_initialized = .False. + logical :: missing_vars_global = .False. real :: nssl_qccn contains @@ -26,7 +27,9 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot, & + mpirank, mpiroot,mpicomm, & + qc, qr, qi, qs, qh, & + ccw, crw, cci, csw, chw, vh, & con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps, & imp_physics, imp_physics_nssl, & @@ -36,6 +39,9 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const +#ifdef MPI + use mpi +#endif implicit none @@ -50,16 +56,32 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0 logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment + real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel + real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number + real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume + ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc + real, parameter :: qmin = 1.e-12 + integer :: ierr + logical :: missing_vars = .False. ! Initialize the CCPP error handling variables @@ -143,6 +165,19 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! For restart runs, the init is done here if (restart) then + + ! For restart, check if the IC is from a different scheme that does not have all the needed variables + missing_vars = .False. + IF ( Any( qc > qmin .and. ccw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qi > qmin .and. cci == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qs > qmin .and. csw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. + +#ifdef MPI + call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) +#endif + is_initialized = .true. return end if @@ -319,6 +354,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array + errflg = 0 @@ -529,8 +565,8 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & dtptmp = dtp ntmul = 1 ENDIF - - IF ( first_time_step .and. .not. restart ) THEN + + IF ( first_time_step .and. ( .not. restart .or. missing_vars_global ) ) THEN itimestep = 0 ! gets incremented to 1 in call loop IF ( nssl_ccn_on ) THEN IF ( invertccn ) THEN diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 1f2023ea9..8449f26cf 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -63,6 +63,101 @@ dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[qc] + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension ,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qh] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[ccw] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[crw] + standard_name = mass_number_concentration_of_rain_water_in_air + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[cci] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[csw] + standard_name = mass_number_concentration_of_snow_in_air + long_name = snow number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_in_air + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vh] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration From 97e3b1ce4e9721ae6cc361733842de53a061d7ed Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 18 Jan 2024 12:24:03 -0500 Subject: [PATCH 117/122] update surface physics z0 from waves --- physics/SFC_Layer/UFS/sfc_diff.f | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index e1bf3c756..5dd6525f9 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -437,6 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif + elseif (z0rl_wav(i) <= 1.0e-7_kp .or. + & z0rl_wav(i) > 1.0_kp) then +! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) + else + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) + endif + endif endif ! end of if(open ocean) From 02b3440378e5bb04ddc4ba50b44f2532eb7cab08 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 19 Jan 2024 18:24:37 +0000 Subject: [PATCH 118/122] "Supplementary physics updates for RRFS code freeze" --- physics/CONV/Grell_Freitas/cu_gf_deep.F90 | 5 +- physics/CONV/Grell_Freitas/cu_gf_driver.F90 | 8 +- physics/CONV/Grell_Freitas/cu_gf_driver.meta | 7 + physics/PBL/MYNN_EDMF/module_bl_mynn.F90 | 146 ++++++++---------- .../SFC_Models/Land/RUC/module_sf_ruclsm.F90 | 6 +- physics/smoke_dust/dep_dry_mod_emerson.F90 | 58 ++++--- physics/smoke_dust/dust_fengsha_mod.F90 | 11 +- physics/smoke_dust/module_add_emiss_burn.F90 | 75 +++++---- physics/smoke_dust/module_plumerise.F90 | 61 +++++--- physics/smoke_dust/module_smoke_plumerise.F90 | 40 ++--- physics/smoke_dust/module_wetdep_ls.F90 | 13 +- physics/smoke_dust/plume_data_mod.F90 | 51 ------ physics/smoke_dust/rrfs_smoke_config.F90 | 3 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 3 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 145 ++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 85 +++++++++- 16 files changed, 424 insertions(+), 293 deletions(-) delete mode 100755 physics/smoke_dust/plume_data_mod.F90 diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index a1bca36c9..8a2c73600 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -142,13 +142,13 @@ subroutine cu_gf_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,tropics) ! + ,jmin,kdt,tropics) ! implicit none integer & ,intent (in ) :: & - nranflag,itf,ktf,its,ite, kts,kte,ipr,imid + nranflag,itf,ktf,its,ite, kts,kte,ipr,imid,kdt integer, intent (in ) :: & ichoice,nchem real(kind=kind_phys), dimension (its:ite,4) & @@ -591,6 +591,7 @@ subroutine cu_gf_deep_run( & sig(i)=(1.-frh)**2 !frh_out(i) = frh if(forcing(i,7).eq.0.)sig(i)=1. + if(kdt.le.(3600./dtime))sig(i)=1. frh_out(i) = frh*sig(i) enddo !$acc end kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 index 92f8760b0..54a23ca74 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 @@ -68,7 +68,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & - do_smoke_transport,errmsg,errflg) + do_smoke_transport,kdt,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -95,7 +95,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer, nchem + integer, intent(in ) :: im,km,ntracer,nchem,kdt integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend @@ -766,7 +766,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,tropics) + ,jminm,kdt,tropics) !$acc kernels do i=its,itf do k=kts,ktf @@ -853,7 +853,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,tropics) + ,jmin,kdt,tropics) jpr=0 ipr=0 !$acc kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index fe9b4c375..d0b661fd8 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -651,6 +651,13 @@ type = real kind = kind_phys intent = inout +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 index 6840f80bf..cc7a47ce6 100644 --- a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 +++ b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 @@ -2001,9 +2001,9 @@ SUBROUTINE mym_length ( & uonset= 15. wt_u = (1.0 - min(max(ugrid - uonset, 0.0)/30.0, 0.5)) cns = 2.7 !was 3.5 - alp1 = 0.22 + alp1 = 0.23 alp2 = 0.3 - alp3 = 2.0 * wt_u !taper off bouyancy enhancement in shear-driven pbls + alp3 = 2.5 * wt_u !taper off bouyancy enhancement in shear-driven pbls alp4 = 5.0 alp5 = 0.3 alp6 = 50. @@ -2059,12 +2059,12 @@ SUBROUTINE mym_length ( & ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN - bv = max( sqrt( gtr*dtv(k) ), 0.001) + bv = max( sqrt( gtr*dtv(k) ), 0.0001) elb = MAX(alp2*qkw(k), & & alp6*edmf_a1(k-1)*edmf_w1(k-1)) / bv & & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) elb = MIN(elb, zwk) - elf = 0.80 * qkw(k)/bv + elf = 1.0 * qkw(k)/bv elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k-1)*edmf_w1(k-1)/bv) ELSE elb = 1.0e10 @@ -2084,8 +2084,10 @@ SUBROUTINE mym_length ( & !add blending to use BouLac mixing length in free atmos; !defined relative to the PBLH (zi) + transition layer (h1) !el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - !try squared-blending - el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + !try squared-blending - but take out elb (makes it underdiffusive) + !el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + el(k) = sqrt( els**2/(1. + (els**2/elt**2))) + el(k) = min(el(k), elb) el(k) = MIN (el(k), elf) el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt @@ -3633,13 +3635,13 @@ SUBROUTINE mym_condensation (kts,kte, & real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & - &ls,wt,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &ls,wt,wt2,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc real(kind_phys), parameter :: qpct_sfc=0.025 real(kind_phys), parameter :: qpct_pbl=0.030 real(kind_phys), parameter :: qpct_trp=0.040 real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 - real(kind_phys), parameter :: rhmax =1.01 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.02 !for cloudpdf = 2 integer :: i,j,k real(kind_phys):: erf @@ -3864,25 +3866,18 @@ SUBROUTINE mym_condensation (kts,kte, & !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) + wt2 = min(max( zagl - pblh2, 0.0 )/300., 1.0) !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) - if (qi(k)>1.e-9 .and. zagl .gt. pblh2) then - rh_hack =min(rhmax, rhcrit + 0.07*(9.0 + log10(qi(k)))) + if ((qi(k)+qs(k))>1.e-9 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.045*(9.0 + log10(qi(k)+qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif - !ensure adequate RH & q1 when qc is at least 1e-6 - if (qc(k)>1.e-6) then - rh_hack =min(rhmax, rhcrit + 0.09*(6.0 + log10(qc(k)))) - rh(k) =max(rh(k), rh_hack) - !add rh-based q1 - q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) - q1(k) =max(q1_rh, q1(k) ) - endif - !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) - if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(rhmax, rhcrit + 0.07*(8.0 + log10(qs(k)))) + !ensure adequate rh & q1 when qc is at least 1e-6 (above the PBLH) + if (qc(k)>1.e-6 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.08*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) @@ -3994,7 +3989,7 @@ SUBROUTINE mym_condensation (kts,kte, & fac_damp = min(zagl * 0.0025, 1.0) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 !HRRRv4 !cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) - cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.35) + cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.37) cldfra_bl1D(K) = min( 1., cld_factor*cldfra_bl1D(K) ) enddo @@ -4181,38 +4176,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & -! sub_u(k)*delt + det_u(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff - & - & dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*uoce*ust**2/wspd - & -! !!!d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*uoce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awu(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff + & - & sub_u(k)*delt + det_u(k)*delt - ENDDO + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*uoce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awu(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff & + & + sub_u(k)*delt + det_u(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+ dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff & + & + sub_u(k)*delt + det_u(k)*delt + enddo !! no flux at the top ! a(kte)=-1. @@ -4247,37 +4237,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & -! sub_v(k)*delt + det_v(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + & - & sub_v(k)*delt + det_v(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*voce*ust**2/wspd - & -! !!!d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*voce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + sub_v(k)*delt + det_v(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff + & - & sub_v(k)*delt + det_v(k)*delt - ENDDO + b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*voce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awv(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff & + & + sub_v(k)*delt + det_v(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff & + & + sub_v(k)*delt + det_v(k)*delt + enddo !! no flux at the top ! a(kte)=-1. diff --git a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index b15592052..2d01f96c9 100644 --- a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -1687,7 +1687,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia endif if(newsn > zero ) then - SNOWFRACnewsn=MIN(one,SNHEI/SNHEI_CRIT_newsn) + SNOWFRACnewsn=MIN(one,snowfallac*1.e-3_kind_phys/SNHEI_CRIT_newsn) endif !-- due to steep slopes and blown snow, limit snow fraction in the @@ -1700,7 +1700,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(snowfrac < 0.75_kind_phys) snow_mosaic = one KEEP_SNOW_ALBEDO = zero - IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN + IF (snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one ! turn off separate treatment of snow covered and snow-free portions of the grid cell @@ -1735,7 +1735,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ! hwlps with these biases.. if( snow_mosaic == one) then ALBsn=alb_snow - if(newsn > zero .and. KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then + if(KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then !-- Albedo correction with fresh snow and deep snow pack !-- will reduce warm bias in western Canada !-- and US West coast, where max snow albedo is low (0.3-0.5). diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index 76fdc2411..771801c44 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -9,7 +9,7 @@ module dep_dry_emerson_mod use machine , only : kind_phys use dep_data_mod ! JLS - use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm + use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm, n_dbg_lines implicit none @@ -23,7 +23,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & settling_flag,drydep_flux,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte, curr_secs, mpiid, xlat, xlong ) ! ! compute dry deposition velocity for aerosol particles ! Based on Emerson et al. (2020), PNAS, @@ -37,6 +37,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + + REAL(kind_phys) :: curr_secs + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(IN) :: ustar, rmol, znt, snowh REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & @@ -80,6 +83,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col integer, dimension(ndvel) :: ndt_settl integer :: i, j, k, ntdt, nv + integer :: icall=0 + integer, INTENT(IN) :: mpiid + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong ! chem pointers (p_*) are not sequentially numbered, need to define so nv loops work integer, dimension(ndvel) :: chem_pointers !> -- Gas constant @@ -87,11 +93,15 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & chem_pointers(1) = p_smoke chem_pointers(2) = p_dust_1 chem_pointers(3) = p_coarse_pm - + growth_fac = 1.0 conver=1.e-9 converi=1.e9 + if (mod(int(curr_secs),1800) .eq. 0) then + icall = 0 + endif + do j = jts, jte do i = its, ite aer_res(i,j) = 0.0 @@ -116,7 +126,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & aer_res(i,j) = max(aer_res(i,j)/100._kind_phys,0._kind_phys) ! Air kinematic viscosity (cm^2/s) airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & - ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 + ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 1.e3 ) ! Convert density to mol/cm^3 ! Air molecular freepath (cm) ! Check against XLM from above freepath = 7.39758e-4 * airkinvisc / sqrt( t_phy(i,k,j) ) do nv = 1, ndvel @@ -141,11 +151,11 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & amu_corrected = amu / Cc ! Gravitational Settling vg = aerodens * dp * dp * gravity * 100. * Cc / & ! Convert gravity to cm/s^2 - ( 18. * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) ) ! Convert density to mol/cm^3 + ( 18. * airkinvisc * ( rho_phy(i,k,j) / 1.e3 ) ) ! Convert density to mol/cm^3 ! -- Rest of loop for the surface when deposition velocity needs to be cacluated if ( k == kts ) then ! Brownian Diffusion - DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) * dp) ! Convert density to mol/cm^3 + DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 1.e3 ) * dp) ! Convert density to mol/cm^3 ! Schmit number Sc = airkinvisc / DDp ! Brownian Diffusion @@ -179,13 +189,17 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & Rs = 1. / ( ( ustar(i,j) * 100.) * ( Eb + Eim + Ein) * eps0 ) ! Convert ustar to cm/s ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] ! The /100. term converts from cm/s to m/s, required for MYNN. - ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) - if ( dbg_opt ) then - WRITE(6,*) 'dry_dep_mod_emerson: i,j,nv',i,j,nv - WRITE(6,*) 'dry_dep_mod_emerson: deposition velocity (m/s) ',ddvel(i,j,nv) + if ( settling_flag == 1 ) then + ddvel(i,j,nv) = max(min( ( vg + 1./(aer_res(i,j)+Rs) )/100., max_dep_vel),0._kind_phys) + else + ddvel(i,j,nv) = max(min( ( 1./(aer_res(i,j)+Rs) )/100., max_dep_vel),0._kind_phys) endif - drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & - (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 + if ( dbg_opt .and. (icall .le. n_dbg_lines) ) then + WRITE(1000+mpiid,*) 'dry_dep_mod_emer:xlat,xlong,curr_secs,nv',xlat(i,j),xlong(i,j),int(curr_secs),nv + WRITE(1000+mpiid,*) 'dry_dep_mod_emer:xlat,xlong,curr_secs,deposition velocity (m/s)',xlat(i,j),xlong(i,j),int(curr_secs),ddvel(i,j,nv) + icall = icall + 1 + endif + drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*rho_phy(i,k,j)*ddvel(i,j,nv)/100.0*dt endif ! k == kts vgrav(i,k,j,nv) = vg ! Fill column variables @@ -220,25 +234,25 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo - do nv = 1, ndvel - chem_before(nv) = 0._kind_phys - do k = kts, kte - chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 - enddo - enddo + !do nv = 1, ndvel + ! chem_before(nv) = 0._kind_phys + ! do k = kts, kte + ! chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + ! enddo + !enddo ! Perform gravitational settling if desired if ( settling_flag == 1 ) then call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) endif ! Put cblk back into chem array do nv= 1, ndvel - chem_after(nv) = 0._kind_phys - settling_flux(i,j,nv) = 0._kind_phys + !chem_after(nv) = 0._kind_phys + !settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) - chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + !chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo ! k - settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 + !settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 enddo ! nv end do ! j end do ! i diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 54e66712d..6ec8f8d4a 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -21,8 +21,8 @@ module dust_fengsha_mod contains subroutine gocart_dust_fengsha_driver(dt, & - chem,rho_phy,smois,p8w,ssm, & - isltyp,snowh,xland,area,g,emis_dust, & + chem,rho_phy,smois,stemp,p8w,ssm, & + isltyp,snowh,xland,area,g,emis_dust, & ust,znt,clay,sand,rdrag,uthr, & num_emis_dust,num_chem,num_soil_layers, & ids,ide, jds,jde, kds,kde, & @@ -54,7 +54,7 @@ subroutine gocart_dust_fengsha_driver(dt, & REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN) :: rho_phy REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), INTENT(INOUT) :: chem REAL(kind_phys), DIMENSION( ims:ime, 1, jms:jme,num_emis_dust),OPTIONAL, INTENT(INOUT) :: emis_dust - REAL(kind_phys), DIMENSION( ims:ime, num_soil_layers, jms:jme ), INTENT(IN) :: smois + REAL(kind_phys), DIMENSION( ims:ime, num_soil_layers, jms:jme ), INTENT(IN) :: smois, stemp !0d input variables REAL(kind_phys), INTENT(IN) :: dt ! time step @@ -146,6 +146,11 @@ subroutine gocart_dust_fengsha_driver(dt, & ilwi = 0 endif + ! Don't emit over frozen soil + if (stemp(i,1,j) < 268.0) then ! -5C + ilwi = 0 + endif + ! Do not allow areas with bedrock, lava, or land-ice to loft IF (isltyp(i,j) .eq. 15 .or. isltyp(i,j) .eq. 16. .or. & diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 95005b973..0a22fcfd7 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -9,11 +9,11 @@ module module_add_emiss_burn subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & chem,julday,gmt,xlat,xlong, & fire_end_hr, peak_hr,time_int, & - coef_bb_dc, fhist, hwp, hwp_prevd, & + coef_bb_dc, fire_hist, hwp, hwp_prevd, & swdown,ebb_dcycle, ebu_in, ebu,fire_type,& ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte,mpiid ) IMPLICIT NONE @@ -22,6 +22,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN) :: mpiid real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem ! shall we set num_chem=1 here? @@ -29,7 +30,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & INTENT(INOUT ) :: ebu real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, swdown - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !, vfrac + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !RAR: Shall we make fire_end integer? real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: coef_bb_dc ! RAR: real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp_prevd @@ -38,17 +39,17 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & real(kind_phys), INTENT(IN) :: time_int,pi ! RAR: time in seconds since start of simulation INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: fire_type integer, INTENT(IN) :: ebb_dcycle ! RAR: this is going to be namelist dependent, ebb_dcycle=means - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fire_hist !>--local integer :: i,j,k,n,m + integer :: icall=0 real(kind_phys) :: conv_rho, conv, dm_smoke, dc_hwp, dc_gp, dc_fn !daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - ! real, parameter :: cx = 2.184936 * 3600., rinti = 2.1813936e-8 , ax = 2000.6038 - ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation - ! For Gaussian diurnal cycle + +! For Gaussian diurnal cycle real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. @@ -90,32 +91,39 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ! Constants for the fire diurnal cycle calculation do j=jts,jte do i=its,ite - fire_age= time_int + (fire_end_hr(i,j))*3600. + fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files + fire_age= MAX(0._kind_phys,fire_age) SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - ! We assume 1hr latency in ingesting the sat. data - coef_bb_dc(i,j) = 1._kind_phys/((2*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) + coef_bb_dc(i,j) = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + + ! IF ( dbg_opt .AND. time_int<5000.) then + ! WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) + ! WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) + ! END IF + CASE (3) age_hr= fire_age/3600._kind_phys - IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN - fhist(i,j)= 0.75_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fire_hist(i,j)>0.75) THEN + fire_hist(i,j)= 0.75_kind_phys ENDIF - IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN - fhist(i,j)= 0.5_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fire_hist(i,j)>0.5) THEN + fire_hist(i,j)= 0.5_kind_phys ENDIF - IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN - fhist(i,j)= 0.25_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fire_hist(i,j)>0.25) THEN + fire_hist(i,j)= 0.25_kind_phys ENDIF ! this is based on hwp, hourly or instantenous TBD - dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1._kind_phys,hwp_prevd(i,j)) + dc_hwp= hwp(i,j)/ MAX(5._kind_phys,hwp_prevd(i,j)) dc_hwp= MAX(0._kind_phys,dc_hwp) + dc_hwp= MIN(25._kind_phys,dc_hwp) - !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( + !coef_bb_dc(i,j)= sc_factor* fire_hist(i,j)* rate_ebb2(i,j)* (1. + log( !hwp_(i,j)/ hwp_day_avg(i,j))) ! RAR: Gaussian profile for wildfires @@ -125,17 +133,30 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_gp = rinti*( ax2 * exp(- dtm**2/(2._kind_phys*cx2**2) ) + const2 - coef2*timeq ) dc_gp = MAX(0._kind_phys,dc_gp) - dc_fn = MAX(dc_hwp/dc_gp,3._kind_phys) - coef_bb_dc(i,j) = fhist(i,j)* dc_fn + dc_fn = MIN(dc_hwp/dc_gp,3._kind_phys) + !coef_bb_dc(i,j) = fire_hist(i,j)* dc_fn + coef_bb_dc(i,j) = fire_hist(i,j)* dc_hwp + + ! IF ( dbg_opt .AND. time_int<5000.) then + ! WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) + ! WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) + ! END IF + CASE DEFAULT END SELECT enddo enddo endif + if (mod(int(time_int),1800) .eq. 0) then + icall = 0 + endif + do j=jts,jte do i=its,ite do k=kts,kfire_max + if (ebu(i,k,j)<0.001_kind_phys) cycle + if (ebb_dcycle==1) then conv= dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) elseif (ebb_dcycle==2) then @@ -143,14 +164,14 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & endif dm_smoke= conv*ebu(i,k,j) chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + chem(i,k,j,p_smoke) = MIN(MAX(chem(i,k,j,p_smoke),0._kind_phys),5.e+3_kind_phys) - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) .and. (icall .le. n_dbg_lines) ) then + WRITE(1000+mpiid,*) 'add_emiss_burn:xlat,xlong,curr_secs,fire_type,fire_hist,peak_hr', xlat(i,j),xlong(i,j),int(time_int),fire_type(i,j),fire_hist(i,j),peak_hr(i,j) + WRITE(1000+mpiid,*) 'add_emiss_burn:xlat,xlong,curr_secs,coef_bb_dc,ebu',xlat(i,j),xlong(i,j),int(time_int),coef_bb_dc(i,j),ebu(i,k,j) + endif enddo + icall = icall + 1 enddo enddo diff --git a/physics/smoke_dust/module_plumerise.F90 b/physics/smoke_dust/module_plumerise.F90 index 8a1d6ab25..5f7ef2a0e 100755 --- a/physics/smoke_dust/module_plumerise.F90 +++ b/physics/smoke_dust/module_plumerise.F90 @@ -24,10 +24,11 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & kpbl_thetav, & ! SRB: added kpbl_thetav ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg) + its,ite, jts,jte, kts,kte, errmsg, errflg,curr_secs, & + xlat, xlong , uspdavg2, hpbl_thetav2, mpiid) use rrfs_smoke_config - use plume_data_mod + !use plume_data_mod USE module_zero_plumegen_coms USE module_smoke_plumerise IMPLICIT NONE @@ -40,6 +41,8 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_inst ! RAR: FRP array + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong ! SRB + real(kind_phys), DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl_thetav ! SRB character(*), intent(inout) :: errmsg @@ -47,6 +50,7 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + real(kind_phys) :: curr_secs INTEGER, INTENT(IN ) :: wind_eff_opt real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd @@ -57,23 +61,32 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & ! Local variables... INTEGER :: nv, i, j, k, kp1, kp2 + INTEGER :: icall=0 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread + REAL, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: uspdavg2, hpbl_thetav2 ! SRB real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev, uspd ! SRB real(kind=kind_phys) :: dz_plume, cpor, con_rocp, uspdavg ! SRB +! MPI variables + INTEGER, INTENT(IN) :: mpiid + cpor =con_cp/con_rd con_rocp=con_rd/con_cp - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte - WRITE(*,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme - WRITE(*,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) + if (mod(int(curr_secs),1800) .eq. 0) then + icall = 0 + endif + + IF ( dbg_opt .and. icall .le. n_dbg_lines) then + WRITE(1000+mpiid,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte + WRITE(1000+mpiid,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme + WRITE(1000+mpiid,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) END IF ! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated !do nv=1,num_ebu do j=jts,jte - do k=kts+1,kte + do k=kts,kte do i=its,ite ebu(i,k,j)=0. enddo @@ -112,12 +125,10 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & uspd(k)= wind_phy(i,k,j) ! SRB enddo - IF (dbg_opt) then - WRITE(*,*) 'module_plumerise: i,j ',i,j - WRITE(*,*) 'module_plumerise: frp_inst(i,j) ',frp_inst(i,j) - WRITE(*,*) 'module_plumerise: ebu(i,kts,j) ',ebu(i,kts,j) - WRITE(*,*) 'module_plumerise: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) - WRITE(*,*) 'module_plumerise: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) + + IF (dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst(i,j) .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'module_plumerise_before:xlat,xlong,curr_secs,ebu(kts),frp_inst',xlat(i,j), xlong(i,j), int(curr_secs),ebu(i,kts,j),frp_inst(i,j) + WRITE(1000+mpiid,*) 'module_plumerise_before:xlat,xlong,curr_secs,u(10),v(10),w(10),qv(10)',xlat(i,j), xlong(i,j),int(curr_secs), u_in(10),v_in(10),w_in(kte),qv_in(10) END IF ! RAR: the plume rise calculation step: @@ -127,7 +138,8 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & wind_eff_opt, & frp_inst(i,j), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & - con_rd, cpor, errmsg, errflg ) + con_rd, cpor, errmsg, errflg, & + icall, mpiid, xlat(i,j), xlong(i,j), curr_secs ) if(errflg/=0) return kp1= k_min(i,j) @@ -136,9 +148,13 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & ! SRB: Adding condition for overwriting plumerise levels uspdavg=SUM(uspd(kts:kpbl_thetav(i,j)))/kpbl_thetav(i,j) !Average wind speed within the boundary layer + +! SRB: Adding output + uspdavg2(i,j) = uspdavg + hpbl_thetav2(i,j) = z_lev(kpbl_thetav(i,j)) IF ((frp_inst(i,j) .gt. frp_threshold) .AND. (frp_inst(i,j) .le. frp_threshold500) .AND. & - (z_at_w(i,kpbl_thetav(i,j),j) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN + (z_lev(kpbl_thetav(i,j)) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN kp1=1 IF (uspdavg .ge. uspd_threshold) THEN ! Too windy kp2=kpbl_thetav(i,j)/3 @@ -157,11 +173,18 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & END IF ! SRB: End modification - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise: i,j ',i,j - WRITE(*,*) 'module_plumerise: k_min(i,j), k_max(i,j) ',kp1, kp2 ! SRB: replaced k_min, k_max with kp1, kp2 + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst(i,j) .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,k_min(i,j), k_max(i,j) ',xlat(i,j),xlong(i,j),int(curr_secs),kp1,kp2 + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,ebu(kts),frp_inst',xlat(i,j),xlong(i,j),int(curr_secs),ebu(i,kts,j),frp_inst(i,j) + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,u(10),v(10),w(10),qv(10)',xlat(i,j),xlong(i,j),int(curr_secs),u_in(10),v_in(10),w_in(kte),qv_in(10) + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,uspdavg,kpbl_thetav',xlat(i,j),xlong(i,j),int(curr_secs),uspdavg,kpbl_thetav(i,j) + IF ( frp_inst(i,j) .ge. 3.e+9 ) then + WRITE(1000+mpiid,*) 'mod_plumerise_after:High FRP at : xlat,xlong,curr_secs,frp_inst',xlat(i,j),xlong(i,j),int(curr_secs),frp_inst(i,j) + END IF + icall = icall + 1 END IF -! endif check_frp +! endif check_frp +! icall = icall + 1 enddo enddo diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 0fca91de4..aa45890f4 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -14,10 +14,11 @@ module module_smoke_plumerise use machine , only : kind_phys - use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std + !use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std !tropical_forest, boreal_forest, savannah, grassland, & ! wind_eff USE module_zero_plumegen_coms + USE rrfs_smoke_config, only : n_dbg_lines !real(kind=kind_phys),parameter :: rgas=r_d !real(kind=kind_phys),parameter :: cpor=cp/r_d @@ -28,12 +29,13 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & - cpor, errmsg, errflg ) + cpor, errmsg, errflg, icall, mpiid, lat, long, curr_secs ) implicit none LOGICAL, INTENT (IN) :: dbg_opt - INTEGER, INTENT (IN) :: wind_eff_opt + INTEGER, INTENT (IN) :: wind_eff_opt, mpiid + real(kind_phys), INTENT(IN) :: lat,long, curr_secs ! SRB ! INTEGER, PARAMETER :: ihr_frp=1, istd_frp=2!, imean_fsize=3, istd_fsize=4 ! RAR: @@ -70,7 +72,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! real(kind=kind_phys), dimension(nveg_agreg) :: firesize,mean_fct INTEGER :: wind_eff - + INTEGER, INTENT(IN) :: icall type(plumegen_coms), pointer :: coms ! Set wind effect from namelist @@ -162,19 +164,11 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & endif burnt_area= max(1.0e4,burnt_area) - IF (dbg_opt) THEN - WRITE(*,*) 'plumerise: m1 ', m1 - WRITE(*,*) 'plumerise: imm, FRP,burnt_area ', imm, FRP,burnt_area - ! WRITE(*,*) 'convert_smold_to_flam ',convert_smold_to_flam - WRITE(*,*) 'plumerise: zcon ', coms%zcon - WRITE(*,*) 'plumerise: zzcon ', coms%zzcon - END IF - - IF (dbg_opt) then - WRITE(*,*) 'plumerise: imm ', imm - WRITE(*,*) 'plumerise: burnt_area ',burnt_area - END IF - + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst .ge. frp_threshold) ) THEN + WRITE(1000+mpiid,*) 'inside plumerise: xlat,xlong,curr_secs, m1 ', lat,long, int(curr_secs), m1 + WRITE(1000+mpiid,*) 'inside plumerise: xlat,xlong,curr_secs,imm,FRP,burnt_area ', lat, long, int(curr_secs), imm, FRP,burnt_area + END IF + !- get fire properties (burned area, plume radius, heating rates ...) call get_fire_properties(coms,imm,iveg_ag,burnt_area,FRP,errmsg,errflg) if(errflg/=0) return @@ -182,8 +176,8 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & !------ generates the plume rise ------ call makeplume (coms,kmt,ztopmax(imm),ixx,imm) - IF (dbg_opt) then - WRITE(*,*) 'plumerise after makeplume: imm,kmt,ztopmax(imm) ',imm,kmt,ztopmax(imm) + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'inside plumerise after makeplume:xlat,xlong,curr_secs,imm,kmt,ztopmax(imm) ', lat, long, int(curr_secs), imm,kmt, ztopmax(imm) END IF enddo lp_minmax @@ -203,12 +197,12 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! enddo !enddo - IF (dbg_opt) then - WRITE(*,*) 'plumerise after set_flam_vert: nkp,k1,k2, ', nkp,k1,k2 - WRITE(*,*) 'plumerise after set_flam_vert: dzi ', dzi + !IF (dbg_opt) then + ! WRITE(*,*) 'plumerise after set_flam_vert: nkp,k1,k2, ', nkp,k1,k2 + ! WRITE(*,*) 'plumerise after set_flam_vert: dzi ', dzi !WRITE(*,*) 'plumerise after set_flam_vert: eburn_in(2) ', eburn_in(2) !WRITE(*,*) 'plumerise after set_flam_vert: eburn_out(:,2) ',eburn_out(:,2) - END IF + !END IF ! enddo lp_veg ! sub-grid vegetation, currently it's aggregated diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index 8ba8f67d9..2ef07e38c 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -31,11 +31,18 @@ subroutine wetdep_ls(dt,var,rain,moist, real(kind_phys) :: dvar,factor,clsum integer :: nv,i,j,k,km,kb,kbeg !real(kind_phys), parameter :: alpha = .5 ! scavenging factor + integer, save :: print_alpha = 0 wetdpr_smoke =0. wetdpr_dust =0. wetdpr_coarsepm=0. + !if ( print_alpha == 0 ) then + ! write(*,*) 'wetdep_ls, alpha = ',alpha + ! print_alpha = print_alpha + 1 + !endif + + do nv=1,nchem do i=its,ite do j=jts,jte @@ -76,11 +83,11 @@ subroutine wetdep_ls(dt,var,rain,moist, dvar=alpha*factor/(1+factor)*var(i,k,j,nv) ! Accumulate diags if (nv .eq. p_smoke ) then - wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) / dt elseif (nv .eq. p_dust_1 ) then - wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) / dt elseif (nv .eq. p_coarse_pm ) then - wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) / dt endif var(i,k,j,nv)=max(1.e-16,var(i,k,j,nv)-dvar) endif diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 deleted file mode 100755 index 3f0bcdecd..000000000 --- a/physics/smoke_dust/plume_data_mod.F90 +++ /dev/null @@ -1,51 +0,0 @@ -!>\file plume_data_mod.F90 -!! This file contains data for the fire plume rise module. - -module plume_data_mod - - use machine , only : kind_phys - - implicit none - - ! -- FRP parameters - integer, dimension(0:20), parameter :: & - catb = (/ & - 0, & - 2, 1, 2, 1, & !floresta tropical 2 and 4 / extra trop fores 1,3,5 - 2, 3, 3, 3, 3, & !cerrado/woody savanna :6 a 9 - 4, 4, 4, 4, 4, 0, 4, 0, 0, 0, 0 & !pastagem/lavouras: 10 ... - /) - - real(kind=kind_phys), dimension(0:4), parameter :: & - flaming = (/ & - 0.00, & ! - 0.45, & ! % biomass burned at flaming phase : tropical forest igbp 2 and 4 - 0.45, & ! % biomass burned at flaming phase : extratropical forest igbp 1 , 3 and 5 - 0.75, & ! % biomass burned at flaming phase : cerrado/woody savanna igbp 6 to 9 - 0.00 & ! % biomass burned at flaming phase : pastagem/lavoura: igbp 10 a 17 - /) - - real(kind=kind_phys), dimension(0:20), parameter :: & - msize= (/ & - 0.00021, & !0near water,1Evergreen needleleaf,2EvergreenBroadleaf,!3Deciduous Needleleaf,4Deciduous Broadleaf - 0.00021, 0.00021, 0.00021, 0.00021, & !5Mixed forest,6Closed shrublands,7Open shrublands,8Woody savannas,9Savannas, - 0.00023, 0.00022, 0.00022, 0.00022, 0.00029, &! 10Grassland,11Permanent wetlands,12cropland,13'Urban and Built-Up' - 0.00029, 0.00021, 0.00026, 0.00021, 0.00026, &!14cropland/natural vegetation mosaic,15Snow and ice,16Barren or sparsely vegetated - 0.00021, 0.00021, 0.00021, 0.00021, 0.00021, 0.00021 & !17Water,18Wooded Tundra,19Mixed Tundra,20Bare Ground Tundra - /) - - ! -- FRP buffer indices - integer, parameter :: p_frp_hr = 1 - integer, parameter :: p_frp_std = 2 - integer, parameter :: num_frp_plume = 2 - - ! -- plumerise parameters - integer, parameter :: tropical_forest = 1 - integer, parameter :: boreal_forest = 2 - integer, parameter :: savannah = 3 - integer, parameter :: grassland = 4 - integer, parameter :: nveg_agreg = 4 - - public - -end module plume_data_mod diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index d7478986b..dae4338bb 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -24,6 +24,7 @@ module rrfs_smoke_config integer :: addsmoke_flag = 1 integer :: smoke_forecast = 1 integer :: plumerisefire_frq=60 + integer :: n_dbg_lines = 3 integer :: wetdep_ls_opt = 1 integer :: drydep_opt = 1 integer :: pm_settling = 1 @@ -39,7 +40,7 @@ module rrfs_smoke_config ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 ! -- hydrometeors integer, parameter :: p_qv=1 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50fbb4e03..8d7481ec4 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = ../hooks/machine.F,dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 - + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index eb7f83af6..4daad7168 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -12,7 +12,7 @@ module rrfs_smoke_wrapper ebb_dcycle, extended_sd_diags,add_fire_heat_flux, & num_moist, num_chem, num_emis_seas, num_emis_dust, & p_qv, p_atm_shum, p_atm_cldq, & - p_smoke, p_dust_1, p_coarse_pm, epsilc + p_smoke, p_dust_1, p_coarse_pm, epsilc, n_dbg_lines use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor use seas_mod, only : gocart_seasalt_driver @@ -52,7 +52,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, dust_moist_correction_in, dust_drylimit_factor_in, & ! Dust namelist aero_ind_fdb_in, & ! Feedback namelist extended_sd_diags_in,dbg_opt_in, & ! Other namelist - errmsg, errflg ) + errmsg, errflg, n_dbg_lines_in ) !>-- Namelist @@ -62,7 +62,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in integer, intent(in) :: drydep_opt_in logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in, add_fire_heat_flux_in - integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in + integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in, n_dbg_lines_in integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in logical, intent(in) :: do_plumerise_in, rrfs_sd character(len=*),intent(out):: errmsg @@ -100,6 +100,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, !>-Other extended_sd_diags = extended_sd_diags_in dbg_opt = dbg_opt_in + n_dbg_lines = n_dbg_lines_in end subroutine rrfs_smoke_wrapper_init @@ -111,17 +112,19 @@ end subroutine rrfs_smoke_wrapper_init subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype_dom, vegtype_frac, soiltyp, nlcat, & + nsoil, smc, tslb, vegtype_dom, vegtype_frac, soiltyp, nlcat, & dswsfc, zorl, snow, julian,recmol, & idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & - ebb_smoke_in, frp_output, coef_bb, ebu_smoke,fhist,min_fplume, & + ebb_smoke_in, frp_output, coef_bb, fire_type_out, & + ebu_smoke,fhist,min_fplume, & max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + peak_hr_out,lu_nofire_out,lu_qfire_out, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & - errmsg,errflg ) + uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg ) implicit none @@ -135,7 +138,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, integer, parameter :: its=1,jts=1,jte=1, kts=1 integer, dimension(:), intent(in) :: land, vegtype_dom, soiltyp - real(kind_phys), dimension(:,:), intent(in) :: smc + real(kind_phys), dimension(:,:), intent(in) :: smc, tslb real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS real(kind_phys), dimension(:,:), intent(in) :: smoke2d_RRFS @@ -153,14 +156,16 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke real(kind_phys), dimension(:,:), intent(inout) :: fire_in real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out - real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume - real(kind_phys), dimension(:), intent( out) :: hwp + real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume, uspdavg, hpbl_thetav + real(kind_phys), dimension(:), intent(inout) :: hwp, peak_hr_out real(kind_phys), dimension(:), intent(inout) :: hwp_ave real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout real(kind_phys), dimension(:,:), intent(inout) :: drydep_flux_out real(kind_phys), dimension(:,:), intent(inout) :: wetdpr real(kind_phys), dimension(:), intent(in) :: wetness + real(kind_phys), dimension(:), intent(out) :: lu_nofire_out,lu_qfire_out + integer, dimension(:), intent(out) :: fire_type_out integer, intent(in) :: imp_physics, imp_physics_thompson integer, dimension(:), intent(in) :: kpbl real(kind_phys), dimension(:), intent(in) :: oro @@ -187,16 +192,17 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac - real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois + real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois, stemp real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp !>- plume variables ! -- buffers real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & - fire_end_hr, hwp_day_avg, kpbl_thetav + fire_end_hr, hwp_day_avg, kpbl_thetav,& + uspdavg2, hpbl_thetav2 integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type - logical :: call_plume, reset_hwp_ave + logical :: call_plume, reset_hwp_ave, avg_hwp_ave !>- optical variables real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav @@ -218,6 +224,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys) :: factor, factor2, factor3 integer :: nbegin, nv integer :: i, j, k, kp, n +! MPI variables + integer :: mpiid + integer, intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot + + mpiid = mpirank errmsg = '' errflg = 0 @@ -232,6 +245,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, min_fplume2 = 0 max_fplume2 = 0 + uspdavg2 = 0. + hpbl_thetav2 = 0. emis_seas = 0. emis_dust = 0. peak_hr = 0. @@ -260,12 +275,17 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- compute incremental convective and large-scale rainfall do i=its,ite rnav(i,1)=max((rain_cpl(i)-rainc_cpl(i))*1000., 0.) ! meter to mm +! coef_bb initializes as clear_val (from GFS_typedefs.F90) +! at ktau = 1, coef_bb_dc is set = 1.0 coef_bb_dc(i,1) = coef_bb(i) +! fhist initializes as 1. (from GFS_typedefs.F90) fire_hist (i,1) = fhist (i) + peak_hr (i,1) = peak_hr_out(i) enddo ! Is this a reset timestep (00:00 + dt)? reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 + avg_hwp_ave = mod(int(curr_secs),3600) == 0 ! plumerise frequency in minutes set up by the namelist input call_plume = (do_plumerise .and. (plumerisefire_frq > 0)) @@ -276,7 +296,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ktau,current_month, current_hour, gmt, con_rd, con_fv, con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & - nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + nsoil,smc,tslb,vegtype_dom,soiltyp, & + nlcat,vegtype_frac,dswsfc,zorl, & snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & @@ -287,20 +308,14 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & - fhist,frp_in, hwp_day_avg, fire_end_hr, & - emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & + fire_hist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,stemp,ivgtyp,isltyp,vegfrac,rmol,swdown,znt, & + hfx,pbl,snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) - do j=jts,jte - do i=its,ite - peak_hr(i,j)= fire_in(i,1) - enddo - enddo - IF (ktau==1) THEN ebu = 0. do j=jts,jte @@ -311,6 +326,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo enddo enddo + ELSE + do k=kts,kte + do i=its,ite + ! ebu is divided by coef_bb_dc since it is applied in the output + ebu(i,k,1)=ebu_smoke(i,k) / coef_bb_dc(i,1) + enddo + enddo ENDIF !RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag @@ -320,6 +342,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, do i=its,ite if (ebu_in(i,j)<0.01) then fire_type(i,j) = 0 + lu_nofire(i,j) = 1.0 else ! Permanent wetlands, snow/ice, water, barren tundra lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) @@ -350,9 +373,10 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif !-- compute dust (opt=5) - if (dust_opt==5) then - call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & - isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & + if (dust_opt==1) then + call gocart_dust_fengsha_driver(dt,chem,rho_phy, & + smois,stemp,p8w,ssm, & + isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & num_emis_dust,num_chem,nsoil, & ids,ide, jds,jde, kds,kde, & @@ -367,6 +391,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag if (add_fire_heat_flux) then + WRITE(1000+mpiid,*) 'Entered add_fire_heat_flux at timestep:',ktau do i = its,ite if ( coef_bb_dc(i,1)*frp_in(i,1) .ge. 1.E7 ) then fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & @@ -396,7 +421,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, kpbl_thetav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg ) + its,ite, jts,jte, kts,kte, errmsg, errflg, curr_secs, & + xlat, xlong, uspdavg2, hpbl_thetav2, mpiid ) if(errflg/=0) return end if @@ -409,7 +435,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, swdown,ebb_dcycle,ebu_in,ebu,fire_type, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte , mpiid ) endif !>-- compute coarsepm setting if using simple dry dep option and @@ -431,7 +457,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, pm_settling,drydep_flux_local,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte, curr_secs, mpiid, xlat, xlong ) do nv=1,ndvel do i=its,ite ddvel_inout(i,nv)=ddvel(i,1,nv) @@ -470,10 +496,12 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif endif -! Smoke emisisons diagnostic +! Smoke emisisons diagnostic, RAR: let's multiply by coef_bb_dc before output +! Since ebu_smoke includes coef_bb_dc, we need to divide by coef_bb_dc when it +! comes back into the wrapper. do k=kts,kte do i=its,ite - ebu_smoke(i,k)=ebu(i,k,1) + ebu_smoke(i,k)=ebu(i,k,1) * coef_bb_dc(i,1) enddo enddo @@ -485,15 +513,21 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, do i=its,ite hwp(i)=hwp_local(i,1) hwp_ave(i) = hwp_ave(i) + hwp(i)*dt + if ( ktau == 1) then + hwp_ave(i) = hwp_ave(i) / dt + elseif ( avg_hwp_ave ) then + hwp_ave(i) = hwp_ave(i) / 3600._kind_phys + endif enddo - + + !---- diagnostic output of dry deposition & gravitational settling fluxes if ( drydep_opt == 1 .and. (extended_sd_diags .or. dbg_opt) ) then do nv = 1, ndvel do i=its,ite drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & - drydep_flux_local(i,1,nv) + & - settling_flux(i,1,nv) + drydep_flux_local(i,1,nv) !+ & + !settling_flux(i,1,nv) enddo enddo endif @@ -520,6 +554,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im +! RAR: let's remove the seas and ant. OC emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & @@ -529,10 +564,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) + fire_type_out(i)=fire_type(i,1) + lu_nofire_out(i)=lu_nofire(i,1) + lu_qfire_out (i)=lu_qfire(i,1) enddo do i = 1, im - fire_in(i,1) = peak_hr(i,1) + peak_hr_out(i) = peak_hr(i,1) enddo !-- to provide real aerosol emission for Thompson MP @@ -568,7 +606,7 @@ subroutine rrfs_smoke_prep( & ktau,current_month,current_hour,gmt,con_rd,con_fv,con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & - nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + nsoil,smc,tslb,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & @@ -579,9 +617,9 @@ subroutine rrfs_smoke_prep( & num_chem, num_moist, & ntsmoke, ntdust, ntcoarsepm, & moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & - fhist,frp_in, hwp_day_avg, fire_end_hr, & - emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & + fire_hist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,stemp,ivgtyp,isltyp,vegfrac,rmol,swdown, & + znt,hfx,pbl,snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -599,7 +637,7 @@ subroutine rrfs_smoke_prep( & u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol real(kind=kind_phys), dimension(ims:ime, nlcat), intent(in) :: vegtype_frac - real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc + real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc,tslb real(kind=kind_phys), dimension(ims:ime, 12, 5), intent(in) :: dust12m_in real(kind=kind_phys), dimension(ims:ime, 24, 2), intent(in) :: smoke_RRFS ! This is a place holder for ebb_dcycle == 2, currently set to hold a single @@ -633,8 +671,8 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_chem), intent(out) :: chem real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: z_at_w - real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois - real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc + real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois,stemp + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fire_hist, coef_bb_dc real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W @@ -730,6 +768,7 @@ subroutine rrfs_smoke_prep( & do j=jts,jte do i=its,ite smois(i,k,j)=smc(i,k) + stemp(i,k,j)=tslb(i,k) enddo enddo enddo @@ -776,13 +815,14 @@ subroutine rrfs_smoke_prep( & rri(i,k,j)=1./rho_phy(i,k,j) vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. - moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) - if (t_phy(i,k,j) > 265.) then - moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) + moist(i,k,j,1)=gq0(i,kkp,1) + !if (t_phy(i,k,j) > 265.) then + moist(i,k,j,2)=gq0(i,kkp,2) if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. - else - moist(i,k,j,2)=0. - endif + !else + ! moist(i,k,j,2)=0. + if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. + !endif !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo @@ -862,11 +902,11 @@ subroutine rrfs_smoke_prep( & if (hour_int .le. 24) then do j=jts,jte do i=its,ite - ebu_in (i,j) = smoke_RRFS(i,hour_int+1,1) ! smoke frp_in (i,j) = smoke_RRFS(i,hour_int+1,2)*conv_frp ! frp - fire_end_hr(i,j) = 0.0 - hwp_day_avg(i,j) = 0.0 + ! These 2 arrays aren't needed for this option + ! fire_end_hr(i,j) = 0.0 + ! hwp_day_avg(i,j) = 0.0 ebb_smoke_in (i) = ebu_in(i,j) enddo enddo @@ -890,7 +930,8 @@ subroutine rrfs_smoke_prep( & if (ktau==1) then do j=jts,jte do i=its,ite - fhist (i,j) = 1. + ! GFS_typedefs.F90 initializes this = 1, but should be OK to duplicate, RAR?? + fire_hist (i,j) = 1. coef_bb_dc (i,j) = 1. if (xlong(i,j)<230.) then peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska @@ -909,7 +950,7 @@ subroutine rrfs_smoke_prep( & enddo endif - ! We will add a namelist variable, real :: flam_frac_global + ! We will add a namelist variable, real :: flam_frac_global, RAR?? do k=kms,kte do i=ims,ime chem(i,k,jts,p_smoke )=max(epsilc,gq0(i,k,ntsmoke )) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index af61ac05e..fc3aa9fe6 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = ../hooks/machine.F,dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] @@ -71,6 +71,13 @@ dimensions = () type = integer intent = in +[n_dbg_lines_in] + standard_name = smoke_debug_lines + long_name = rrfs smoke add smoke option + units = index + dimensions = () + type = integer + intent = in [plume_wind_eff_in] standard_name = option_for_wind_effects_on_smoke_plumerise long_name = wind effect plumerise option @@ -406,6 +413,14 @@ type = real kind = kind_phys intent = inout +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in [vegtype_dom] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell @@ -715,6 +730,13 @@ type = real kind = kind_phys intent = inout +[fire_type_out] + standard_name = fire_type_out + long_name = type of fire + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = out [ebu_smoke] standard_name = ebu_smoke long_name = buffer of vertical fire emission @@ -747,6 +769,43 @@ type = real kind = kind_phys intent = inout +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[uspdavg] + standard_name = bl_averaged_wind_speed + long_name = average wind speed within the boundary layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[hpbl_thetav] + standard_name = pbl_height_thetav + long_name = pbl height based on modified parcel method + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [drydep_flux_out] standard_name = dry_deposition_flux long_name = rrfs dry deposition flux @@ -810,6 +869,30 @@ type = real kind = kind_phys intent = inout +[peak_hr_out] + standard_name = peak_hr_fire + long_name = hour of peak fire emissions + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lu_nofire_out] + standard_name = lu_nofire_out + long_name = land use of no fire pixels for type + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lu_qfire_out] + standard_name = lu_qfire_out + long_name = land use of fire pixels for type + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [fire_heat_flux_out] standard_name = surface_fire_heat_flux long_name = heat flux of fire at the surface From c0544c218776d4a94169d45cb7dae102800594a1 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Tue, 23 Jan 2024 16:13:19 +0000 Subject: [PATCH 119/122] "update to address code reviewer's comments" --- physics/smoke_dust/dep_dry_mod_emerson.F90 | 14 ---------- physics/smoke_dust/module_add_emiss_burn.F90 | 27 +++++++++---------- physics/smoke_dust/rrfs_smoke_config.F90 | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 14 +++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 28 +++++++------------- 5 files changed, 27 insertions(+), 58 deletions(-) diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index 771801c44..e69d6bc3f 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -179,10 +179,6 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & eps0 = eps0_grs end if ! Set if snow greater than 1 cm -! if ( snowh(i,j) .gt. 0.01 ) then ! snow -! A = A_wat -! eps0 = eps0_wat -! endif ! Interception Ein = Cin * ( dp / A )**vv ! Surface resistance @@ -234,25 +230,15 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo - !do nv = 1, ndvel - ! chem_before(nv) = 0._kind_phys - ! do k = kts, kte - ! chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 - ! enddo - !enddo ! Perform gravitational settling if desired if ( settling_flag == 1 ) then call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) endif ! Put cblk back into chem array do nv= 1, ndvel - !chem_after(nv) = 0._kind_phys - !settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) - !chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo ! k - !settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 enddo ! nv end do ! j end do ! i diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 0a22fcfd7..f1bbaeee9 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -47,7 +47,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm, coef_con ! For BB emis. diurnal cycle calculation ! For Gaussian diurnal cycle real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later @@ -89,6 +89,8 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & if (ebb_dcycle==2) then ! Constants for the fire diurnal cycle calculation + coef_con = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) do j=jts,jte do i=its,ite fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files @@ -97,13 +99,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - coef_bb_dc(i,j) = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + coef_bb_dc(i,j) = coef_con - ! IF ( dbg_opt .AND. time_int<5000.) then - ! WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) - ! WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) - ! END IF + IF ( dbg_opt .AND. time_int<5000.) then + WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) + WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) + END IF CASE (3) age_hr= fire_age/3600._kind_phys @@ -123,9 +124,6 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_hwp= MAX(0._kind_phys,dc_hwp) dc_hwp= MIN(25._kind_phys,dc_hwp) - !coef_bb_dc(i,j)= sc_factor* fire_hist(i,j)* rate_ebb2(i,j)* (1. + log( - !hwp_(i,j)/ hwp_day_avg(i,j))) - ! RAR: Gaussian profile for wildfires dt1= abs(timeq - peak_hr(i,j)) dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. @@ -134,13 +132,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_gp = MAX(0._kind_phys,dc_gp) dc_fn = MIN(dc_hwp/dc_gp,3._kind_phys) - !coef_bb_dc(i,j) = fire_hist(i,j)* dc_fn coef_bb_dc(i,j) = fire_hist(i,j)* dc_hwp - ! IF ( dbg_opt .AND. time_int<5000.) then - ! WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) - ! WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) - ! END IF + IF ( dbg_opt .AND. time_int<5000.) then + WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) + WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) + END IF CASE DEFAULT END SELECT diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index dae4338bb..c20d6e2db 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -40,7 +40,7 @@ module rrfs_smoke_config ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 ! -- hydrometeors integer, parameter :: p_qv=1 diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 4daad7168..3842cba54 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -121,7 +121,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & ebb_smoke_in, frp_output, coef_bb, fire_type_out, & ebu_smoke,fhist,min_fplume, & - max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout, & peak_hr_out,lu_nofire_out,lu_qfire_out, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg ) @@ -154,8 +154,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_output, fhist real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke - real(kind_phys), dimension(:,:), intent(inout) :: fire_in - real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out + real(kind_phys), dimension(:), intent(out ) :: fire_heat_flux_out, frac_grid_burned_out real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume, uspdavg, hpbl_thetav real(kind_phys), dimension(:), intent(inout) :: hwp, peak_hr_out real(kind_phys), dimension(:), intent(inout) :: hwp_ave @@ -816,13 +815,8 @@ subroutine rrfs_smoke_prep( & vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. moist(i,k,j,1)=gq0(i,kkp,1) - !if (t_phy(i,k,j) > 265.) then - moist(i,k,j,2)=gq0(i,kkp,2) - if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. - !else - ! moist(i,k,j,2)=0. - if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. - !endif + moist(i,k,j,2)=gq0(i,kkp,2) + if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index fc3aa9fe6..e00781ec1 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -731,9 +731,9 @@ kind = kind_phys intent = inout [fire_type_out] - standard_name = fire_type_out + standard_name = fire_type long_name = type of fire - units = none + units = 1 dimensions = (horizontal_loop_extent) type = integer intent = out @@ -791,17 +791,17 @@ type = integer intent = in [uspdavg] - standard_name = bl_averaged_wind_speed + standard_name = mean_wind_speed_in_boundary_layer long_name = average wind speed within the boundary layer - units = none + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout [hpbl_thetav] - standard_name = pbl_height_thetav + standard_name = atmosphere_boundary_layer_thickness_from_modified_parcel long_name = pbl height based on modified parcel method - units = none + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -861,24 +861,16 @@ type = real kind = kind_phys intent = inout -[fire_in] - standard_name = smoke_fire_auxiliary_input - long_name = smoke fire auxiliary input variables - units = various - dimensions = (horizontal_loop_extent,fire_auxiliary_data_extent) - type = real - kind = kind_phys - intent = inout [peak_hr_out] standard_name = peak_hr_fire - long_name = hour of peak fire emissions - units = none + long_name = time_of_peak_fire_emissions + units = s dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out [lu_nofire_out] - standard_name = lu_nofire_out + standard_name = sum_of_land_use_fractions_for_no_fire_pixels long_name = land use of no fire pixels for type units = frac dimensions = (horizontal_loop_extent) @@ -886,7 +878,7 @@ kind = kind_phys intent = out [lu_qfire_out] - standard_name = lu_qfire_out + standard_name = sum_of_land_use_fractions_for_cropland_fire_pixels long_name = land use of fire pixels for type units = frac dimensions = (horizontal_loop_extent) From a0acaedeb7512f9c3cc062922b83466ffdfc2478 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Wed, 24 Jan 2024 16:35:59 +0000 Subject: [PATCH 120/122] "update to resolve code managers' comments" --- physics/smoke_dust/module_add_emiss_burn.F90 | 6 +++--- physics/smoke_dust/rrfs_smoke_wrapper.meta | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index f1bbaeee9..80d91bb0e 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -89,8 +89,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & if (ebb_dcycle==2) then ! Constants for the fire diurnal cycle calculation - coef_con = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + coef_con=1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys) do j=jts,jte do i=its,ite fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files @@ -99,7 +98,8 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - coef_bb_dc(i,j) = coef_con + coef_bb_dc(i,j) = coef_con*1._kind_phys/(sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) IF ( dbg_opt .AND. time_int<5000.) then WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index e00781ec1..271d2dd36 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -872,7 +872,7 @@ [lu_nofire_out] standard_name = sum_of_land_use_fractions_for_no_fire_pixels long_name = land use of no fire pixels for type - units = frac + units = 1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -880,7 +880,7 @@ [lu_qfire_out] standard_name = sum_of_land_use_fractions_for_cropland_fire_pixels long_name = land use of fire pixels for type - units = frac + units = 1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys From 4bdf3fab29da51e487143e8b5e3ce8ed5d599127 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:49:22 +0000 Subject: [PATCH 121/122] add kind_phys to parameter in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index ad1d41090..e250527c4 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -79,7 +79,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) integer :: ihailv,ipc - real, parameter :: qmin = 1.e-12 + real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr logical :: missing_vars = .False. @@ -347,7 +347,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & its,ite, jts,jte, kts,kte, i,j,k integer :: itimestep ! timestep counter integer :: ntmul, n - real, parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) + real(kind_phys), parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn From be9b2b726d5ab08a7630def5b7559d55fa6dcd1f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 25 Jan 2024 14:54:44 +0000 Subject: [PATCH 122/122] add more kind_phys to real variables in mp_nssl --- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index e250527c4..0b111f7cd 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -77,7 +77,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k - real :: nssl_params(20) + real(kind_phys) :: nssl_params(20) integer :: ihailv,ipc real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr @@ -351,7 +351,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn - real :: cwmas + real(kind_phys) :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array