From 02c5b01ddcae2f51922417538afe110fcba20124 Mon Sep 17 00:00:00 2001 From: bluefinweiwei Date: Wed, 20 Mar 2024 22:47:22 +0000 Subject: [PATCH] Add physics simulator files only for SCM new file: Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 new file: Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta new file: Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 new file: Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta --- .../UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 | 212 +++++++++++ .../UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta | 201 +++++++++++ .../module_ccpp_suite_simulator.F90 | 328 ++++++++++++++++++ .../module_ccpp_suite_simulator.meta | 24 ++ 4 files changed, 765 insertions(+) create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 new file mode 100644 index 000000000..c1592263d --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 @@ -0,0 +1,212 @@ +! ######################################################################################## +! +! 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/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta new file mode 100644 index 000000000..3c91faaeb --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta @@ -0,0 +1,201 @@ +[ccpp-table-properties] + name = ccpp_suite_simulator + type = scheme + dependencies = ../../hooks/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/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 new file mode 100644 index 000000000..c4f9fc4e4 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 @@ -0,0 +1,328 @@ +! ######################################################################################## +! +! 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/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta new file mode 100644 index 000000000..55b9e07b1 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_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_suite_simulator + type = module + dependencies = ../../hooks/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