From a3933a549c7ced2ae9f9c7b30b42090cfa2134ca Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 4 May 2023 11:20:02 -0600 Subject: [PATCH] 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