From e6f1f93c638bab12d4238db903b2c51d339009bb Mon Sep 17 00:00:00 2001 From: bluefinweiwei Date: Sun, 12 Jan 2025 22:16:45 +0000 Subject: [PATCH] Connect CCPP SCM with HR4 physics from hr.v4 tag from ufs-weather-model repo https://github.com/ufs-community/ufs-weather-model/tree/hr.v4 new file: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 new file: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta new file: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 new file: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 modified: physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta new file: physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 new file: physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta new file: physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 new file: physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta modified: physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 new file: physics/photochem/module_h2ophys.F90 new file: physics/photochem/module_h2ophys.meta modified: physics/photochem/module_ozphys.F90 --- .../GFS_ccpp_suite_sim_pre.F90 | 441 ++++++++++++++++++ .../GFS_ccpp_suite_sim_pre.meta | 175 +++++++ .../UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 110 +++++ .../UFS_SCM_NEPTUNE/GFS_photochemistry.meta | 211 +++++++++ .../GFS_phys_time_vary.fv3.F90 | 50 +- .../GFS_phys_time_vary.fv3.meta | 17 +- .../GFS_phys_time_vary.scm.F90 | 95 ++-- .../GFS_phys_time_vary.scm.meta | 91 +++- .../GFS_suite_stateout_update.F90 | 44 +- .../GFS_suite_stateout_update.meta | 106 +---- .../UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 | 211 +++++++++ .../UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta | 201 ++++++++ .../module_ccpp_suite_simulator.F90 | 307 ++++++++++++ .../module_ccpp_suite_simulator.meta | 24 + .../UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 | 13 +- physics/photochem/module_h2ophys.F90 | 237 ++++++++++ physics/photochem/module_h2ophys.meta | 25 + physics/photochem/module_ozphys.F90 | 70 ++- 18 files changed, 2152 insertions(+), 276 deletions(-) create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta 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 create mode 100644 physics/photochem/module_h2ophys.F90 create mode 100644 physics/photochem/module_h2ophys.meta diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 new file mode 100644 index 000000000..9a5ce6112 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 @@ -0,0 +1,441 @@ +!>\file GFS_ccpp_suite_sim_pre.F90 +!! Interstitial CCPP suite to couple UFS physics to CCPP suite simulator. + +! ######################################################################################## +! +! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. +! +! Contains: +! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. +! called once during model initialization +! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_suite_simulator. +! +! ######################################################################################## +module GFS_ccpp_suite_sim_pre + use machine, only: kind_phys + use module_ccpp_suite_simulator, only: base_physics_process + use netcdf + implicit none + public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim +contains + +!> \section arg_table_GFS_ccpp_suite_sim_pre_run Argument Table +!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html +!! + subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & + index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & + index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & + index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & + errmsg, errflg) + + ! Inputs + logical, intent(in) :: do_ccpp_suite_sim + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:), optional :: dtend + type(base_physics_process),intent(in) :: physics_process(:) + integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q + + ! Outputs + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: idtend, iactive + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_suite_sim) return + + ! Get tendency for "active" process. + + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics suites. Not all suites output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. + ! + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + ! ###################################################################################### + if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave + if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave + if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl + if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd + if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv + if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv + if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp + endif + + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp + endif + + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp + endif + + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp + endif + + end subroutine GFS_ccpp_suite_sim_pre_run + + ! ###################################################################################### +!> + subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & + iactive_u, iactive_v, iactive_q, errmsg, errflg) + + ! Inputs + integer, intent (in) :: nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + type(base_physics_process),intent(inout),allocatable :: physics_process(:) + integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q + integer, intent(out) :: errflg + character(len=256), intent(out) :: errmsg + + ! Local variables + integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data + character(len=256) :: suite_sim_file + logical :: exists, do_ccpp_suite_sim + integer :: nprc_sim + + ! For each process there is a corresponding namelist entry, which is constructed as + ! follows: + ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + prc_LWRAD_cfg = (/0,0,0/), & + prc_SWRAD_cfg = (/0,0,0/), & + prc_PBL_cfg = (/0,0,0/), & + prc_GWD_cfg = (/0,0,0/), & + prc_SCNV_cfg = (/0,0,0/), & + prc_DCNV_cfg = (/0,0,0/), & + prc_cldMP_cfg = (/0,0,0/) + + ! Namelist + namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + prc_DCNV_cfg, prc_cldMP_cfg + + errmsg = '' + errflg = 0 + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) + close (nlunit) + + ! Only proceed if suite simulator requested. + if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & + prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & + prc_cldMP_cfg(1) == 1 ) then + else + return + endif + + ! Check that input data file exists. + inquire (file = trim (suite_sim_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' + errflg = 1 + return + endif + + ! + ! Read data file... + ! + + ! Open file + status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) + errflg = 1 + return + endif + + ! Metadata (dimensions) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' + errflg = 1 + return + endif + + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' + errflg = 1 + return + endif + + ! Allocate space and read in data + allocate(physics_process(nprc_sim)) + physics_process(1)%active_name = '' + physics_process(1)%iactive_scheme = 0 + physics_process(1)%active_tsp = .false. + do iprc = 1,nprc_sim + allocate(physics_process(iprc)%tend1d%T( nlev_data )) + allocate(physics_process(iprc)%tend1d%u( nlev_data )) + allocate(physics_process(iprc)%tend1d%v( nlev_data )) + allocate(physics_process(iprc)%tend1d%q( nlev_data )) + allocate(physics_process(iprc)%tend2d%time( ntime_data)) + allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) + + ! Temporal info + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) + else + errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' + errflg = 1 + return + endif + + if (iprc == prc_SWRAD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (prc_SWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 + endif + if (prc_SWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + endif + + if (iprc == prc_LWRAD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (prc_LWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 + endif + if (prc_LWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + endif + + if (iprc == prc_GWD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (prc_GWD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 3 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + endif + if (prc_GWD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + endif + + if (iprc == prc_PBL_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (prc_PBL_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_PBL_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + endif + + if (iprc == prc_SCNV_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (prc_SCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_SCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + if (iprc == prc_DCNV_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (prc_DCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_DCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + if (iprc == prc_cldMP_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (prc_cldMP_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 2 + iactive_T = 1 + iactive_q = 2 + endif + if (prc_cldMP_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + ! Which process-suite is "active"? Is process time-split? + if (.not. physics_process(iprc)%use_sim) then + physics_process(1)%iactive_scheme = iprc + physics_process(1)%active_name = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + physics_process(1)%active_tsp = .true. + endif + endif + + enddo + + if (physics_process(1)%iactive_scheme == 0) then + errflg = 1 + errmsg = "ERROR: No active suite set for CCPP suite simulator" + return + endif + + print*, "-----------------------------------" + print*, "--- Using CCPP suite simulator ---" + print*, "-----------------------------------" + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_suite: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_suite: ", trim(physics_process(1)%active_name) + print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order + print*, " time_split : ", physics_process(1)%active_tsp + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" + + end subroutine load_ccpp_suite_sim + +end module GFS_ccpp_suite_sim_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta new file mode 100644 index 000000000..c25a3dd05 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta @@ -0,0 +1,175 @@ +[ccpp-table-properties] + name = GFS_ccpp_suite_sim_pre + type = scheme + dependencies = ../../hooks/machine.F,module_ccpp_suite_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_suite_sim_pre_run + type = scheme +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator + units = flag + dimensions = () + type = logical + intent = in +[physics_process] + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) + type = base_physics_process + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in + optional = True +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) + type = real + kind = kind_phys + intent = out +[iactive_T] + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 new file mode 100644 index 000000000..94c6d1c3b --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -0,0 +1,110 @@ +! ######################################################################################### +!> \file GFS_photochemistry.f90 +!! +! ######################################################################################### +module GFS_photochemistry + use machine, only: kind_phys + use module_ozphys, only: ty_ozphys + use module_h2ophys, only: ty_h2ophys + implicit none +contains + +! ######################################################################################### +!> \section arg_table_GFS_photochemistry_init Argument Table +!! \htmlinclude GFS_photochemistry_init.html +!! +! ######################################################################################### + subroutine GFS_photochemistry_init(oz_phys_2006, oz_phys_2015, h2o_phys, errmsg, errflg) + logical, intent(in) :: & + oz_phys_2015, & ! Do ozone photochemistry? (2015) + oz_phys_2006, & ! Do ozone photochemistry? (2006) + h2o_phys ! Do stratospheric h2o photochemistry? + character(len=*), intent(out) :: & + errmsg ! CCPP Error message. + integer, intent(out) :: & + errflg ! CCPP Error flag. + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! If no photchemical scheme is on, but SDF has this module, report an error? + if ((.not. oz_phys_2006) .and. (.not. oz_phys_2015) .and. (.not. h2o_phys)) then + write (errmsg,'(*(a))') 'Logic error: One of [oz_phys_2006, oz_phys_2015, or h2o_phys] must == .true. ' + errflg = 1 + return + endif + + ! Only one ozone scheme can be on. Otherwise, return and report error. + if (oz_phys_2006 .and. oz_phys_2015) then + write (errmsg,'(*(a))') 'Logic error: Only one ozone scheme can be enabled at a time' + errflg = 1 + return + endif + + end subroutine GFS_photochemistry_init + +! ######################################################################################### +!> \section arg_table_GFS_photochemistry_run Argument Table +!! \htmlinclude GFS_photochemistry_run.html +!! +! ######################################################################################### + subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, & + prsl, dp, ozpl, h2o_phys, h2ophys, h2opl, h2o0, oz0, gt0, do3_dt_prd, do3_dt_ozmx, & + do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + + ! Inputs + real(kind=kind_phys), intent(in) :: & + dtp, & ! Model timestep + con_1ovg ! Physical constant (1./gravity) + real(kind=kind_phys), intent(in), dimension(:,:) :: & + prsl, & ! Air pressure (Pa) + dp, & ! Pressure thickness (Pa) + gt0 ! Air temperature (K) + real(kind=kind_phys), intent(in), dimension(:,:,:) :: & + ozpl, & ! Ozone data for current model timestep. + h2opl ! h2o data for curent model timestep. + logical, intent(in) :: & + oz_phys_2015, & ! Do ozone photochemistry? (2015) + oz_phys_2006, & ! Do ozone photochemistry? (2006) + h2o_phys ! Do stratospheric h2o photochemistry? + type(ty_ozphys), intent(in) :: & + ozphys ! DDT with ozone photochemistry scheme/data. + type(ty_h2ophys), intent(in) :: & + h2ophys ! DDT with h2o photochemistry scheme/data. + + ! Outputs (optional) + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Outputs + real(kind=kind_phys), intent(inout), dimension(:,:) :: & + oz0, & ! Update ozone concentration. + h2o0 ! Updated h2o concentration. + character(len=*), intent(out) :: & + errmsg ! CCPP Error message. + integer, intent(out) :: & + errflg ! CCPP Error flag. + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (oz_phys_2015) then + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (oz_phys_2006) then + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (h2o_phys) then + call h2ophys%run(dtp, prsl, h2opl, h2o0) + endif + + end subroutine GFS_photochemistry_run + +end module GFS_photochemistry diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta new file mode 100644 index 000000000..f8874fef7 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -0,0 +1,211 @@ +######################################################################## +[ccpp-table-properties] + name = GFS_photochemistry + type = scheme + dependencies = ../../hooks/machine.F,../../photochem/module_ozphys.F90 + dependencies = ../../photochem/module_h2ophys.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_photochemistry_init + type = scheme +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = GFS_photochemistry_run + type = scheme +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[dp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in +[h2opl] + standard_name = stratospheric_water_vapor_forcing + long_name = water forcing data + units = mixed + dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in +[h2o0] + standard_name = specific_humidity_of_new_state + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[oz0] + standard_name = ozone_concentration_of_new_state + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[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 = in +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[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/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index 08d1d0b49..b556af06f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -15,9 +15,7 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number use module_ozphys, only: ty_ozphys - - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use module_h2ophys, only: ty_h2ophys use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf @@ -97,7 +95,7 @@ subroutine GFS_phys_time_vary_init ( smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & - lakefrac_threshold, lakedepth_threshold, ozphys, errmsg, errflg) + lakefrac_threshold, lakedepth_threshold, ozphys, h2ophys, errmsg, errflg) implicit none @@ -133,6 +131,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound @@ -222,29 +221,6 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_h2odata() to read stratospheric water vapor data - need_h2odata: if(h2o_phys) then - call read_h2odata (h2o_phys, me, master) - - ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata - ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(h2opl, dim=2).ne.levh2o) then - write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(h2opl, dim=2) - myerrflg = 1 - call copy_error(myerrmsg, myerrflg, errmsg, errflg) - end if - if (size(h2opl, dim=3).ne.h2o_coeff) then - write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(h2opl, dim=3) - myerrflg = 1 - call copy_error(myerrmsg, myerrflg, errmsg, errflg) - end if - endif need_h2odata - !> - Call read_aerdata() to read aerosol climatology, Anning added coupled !> added coupled gocart and radiation option to initializing aer_nm if (iaerclm) then @@ -305,7 +281,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then - call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) + call h2ophys%setup(xlat_d, jindx1_h, jindx2_h, ddy_h) endif !> - Call setindxaer() to initialize aerosols data @@ -736,7 +712,7 @@ subroutine GFS_phys_time_vary_timestep_init ( lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, h2ophys, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none @@ -767,6 +743,7 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil @@ -814,7 +791,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,h2ophys,rjday,n1,n2,idat,jdat,rinc) & !$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & !$OMP private(iseed,iskip,i,j,k) @@ -897,12 +874,9 @@ subroutine GFS_phys_time_vary_timestep_init ( call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif -!$OMP section -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation +!> - Update stratospheric h2o concentration. if (h2o_phys) then - call h2ointerpol (me, im, idate, fhour, & - jindx1_h, jindx2_h, & - h2opl, ddy_h) + call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif !$OMP section @@ -994,12 +968,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) - ! Deallocate aerosol arrays if (allocated(aerin) ) deallocate(aerin) if (allocated(aer_pres)) deallocate(aer_pres) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index df957e257..44a5b92f9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -8,8 +8,7 @@ dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = photochem/module_ozphys.F90 - dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = photochem/module_ozphys.F90,photochem/module_h2ophys.F90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## @@ -1036,6 +1035,13 @@ dimensions = () type = ty_ozphys intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -2042,6 +2048,13 @@ dimensions = () type = ty_ozphys intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index 59b59e76a..35b46618c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 @@ -12,9 +12,7 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number use module_ozphys, only: ty_ozphys - - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use module_h2ophys, only: ty_h2ophys use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf @@ -30,12 +28,12 @@ module GFS_phys_time_vary use set_soilveg_mod, only: set_soilveg ! --- needed for Noah MP init - use noahmp_tables, only: laim_table,saim_table,sla_table, & + use noahmp_tables, only: read_mp_table_parameters, & + laim_table,saim_table,sla_table, & bexp_table,smcmax_table,smcwlt_table, & dwsat_table,dksat_table,psisat_table, & isurban_table,isbarren_table, & isice_table,iswater_table - implicit none private @@ -61,7 +59,7 @@ module GFS_phys_time_vary !! @{ subroutine GFS_phys_time_vary_init ( & me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozphys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + jindx1_o3, jindx2_o3, ddy_o3, ozphys, h2ophys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -73,17 +71,22 @@ subroutine GFS_phys_time_vary_init ( zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & - errmsg, errflg) + lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & + lakefrac_threshold, lakedepth_threshold, errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start - integer, intent(in) :: idate(:) - real(kind_phys), intent(in) :: fhour + integer, intent(in) :: idate(:), iopt_lake, iopt_lake_clm, iopt_lake_flake + real(kind_phys), intent(in) :: fhour, lakefrac_threshold, lakedepth_threshold real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + integer, intent(in) :: lkm + integer, intent(inout) :: use_lake_model(:) + real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) + integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) @@ -104,6 +107,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound @@ -189,25 +193,6 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_h2odata() to read stratospheric water vapor data - call read_h2odata (h2o_phys, me, master) - - ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata - ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(h2opl, dim=2).ne.levh2o) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(h2opl, dim=2) - errflg = 1 - end if - if (size(h2opl, dim=3).ne.h2o_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(h2opl, dim=3) - errflg = 1 - end if - !> - Call read_aerdata() to read aerosol climatology if (iaerclm) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 @@ -225,6 +210,7 @@ subroutine GFS_phys_time_vary_init ( ! Read aerosol climatology call read_aerdata (me,master,iflip,idate,errmsg,errflg) endif + if (errflg /= 0) return else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. @@ -232,7 +218,7 @@ subroutine GFS_phys_time_vary_init ( ntrcaer = size(aer_nm, dim=3) endif -!> - Call read_cidata() to read IN and CCN data +!> - Call iccninterp::read_cidata() to read IN and CCN data if (iccn == 1) then call read_cidata (me,master) ! No consistency check needed for in/ccn data, all values are @@ -247,6 +233,11 @@ subroutine GFS_phys_time_vary_init ( !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) +!> - read in NoahMP table (needed for NoahMP init) + if(lsm == lsm_noahmp) then + call read_mp_table_parameters(errmsg, errflg) + endif + !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) @@ -254,7 +245,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then - call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) + call h2ophys%setup(xlat_d, jindx1_h, jindx2_h, ddy_h) endif !> - Call setindxaer() to initialize aerosols data @@ -523,8 +514,10 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 +! using stc and tgxy to linearly interpolate the snow temp for each layer + do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo @@ -595,6 +588,26 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init + ! Lake model + if(lkm>0 .and. iopt_lake>0) then + ! A lake model is enabled. + do i = 1, im + !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then + ! The lake data must say there's a lake here (lakefrac) with a depth (lakedepth) + if (lakefrac(i) > lakefrac_threshold .and. lakedepth(i) > lakedepth_threshold ) then + ! This is a lake point. Inform the other schemes to use a lake model, and possibly nsst (lkm) + use_lake_model(i) = lkm + cycle + else + ! Not a valid lake point. + use_lake_model(i) = 0 + endif + enddo + else + ! Lake model is disabled or settings are invalid. + use_lake_model = 0 + endif + is_initialized = .true. contains @@ -633,7 +646,7 @@ end subroutine GFS_phys_time_vary_init !! @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, ozphys, ntoz, h2o_phys, iaerclm, iccn, clstp, & + imfdeepcnv, cal_pre, random_clds, ozphys, h2ophys, ntoz, h2o_phys, iaerclm, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & @@ -668,6 +681,7 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -770,11 +784,9 @@ subroutine GFS_phys_time_vary_timestep_init ( call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation +!> - Update stratospheric h2o concentration. if (h2o_phys) then - call h2ointerpol (me, im, idate, fhour, & - jindx1_h, jindx2_h, & - h2opl, ddy_h) + call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif !> - Call ciinterpol() to make IN and CCN data interpolation @@ -801,7 +813,10 @@ subroutine GFS_phys_time_vary_timestep_init ( fhour, iflip, jindx1_aer, jindx2_aer, & ddy_aer, iindx1_aer, & iindx2_aer, ddx_aer, & - levs, prsl, aer_nm) + levs, prsl, aer_nm, errmsg, errflg) + if(errflg /= 0) then + return + endif endif ! Not needed for SCM: @@ -859,12 +874,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) - ! Deallocate aerosol arrays if (allocated(aerin) ) deallocate(aerin) if (allocated(aer_pres)) deallocate(aer_pres) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 43397f854..5dae234ea 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -7,8 +7,7 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = photochem/module_ozphys.F90 - dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = photochem/module_ozphys.F90,photochem/module_h2ophys.F90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## @@ -109,6 +108,20 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in [jindx1_o3] standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation low index for ozone @@ -947,6 +960,73 @@ dimensions = () type = integer intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lakefrac_threshold] + standard_name = lakefrac_threshold_for_enabling_lake_model + long_name = fraction of horizontal grid area occupied by lake must be greater than this value to enable a lake model + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[lakedepth_threshold] + standard_name = lake_depth_threshold_for_enabling_lake_model + long_name = lake depth must be greater than this value to enable a lake model + units = m + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1441,6 +1521,13 @@ dimensions = () type = ty_ozphys intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in [nthrds] standard_name = number_of_openmp_threads long_name = number of OpenMP threads available for physics schemes diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 index c2f5266fd..e5a20a77d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -1,24 +1,20 @@ -! ######################################################################################### !> \file GFS_suite_stateout_update.f90 !! Update the state variables due to process-split physics from accumulated tendencies !! during that phase. !! Update gas concentrations, if using prognostic photolysis schemes. !! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. -! ######################################################################################### module GFS_suite_stateout_update - use machine, only: kind_phys - use module_ozphys, only: ty_ozphys + use machine, only: kind_phys implicit none + contains -! ######################################################################################### + !> \section arg_table_GFS_suite_stateout_update_run Argument Table !! \htmlinclude GFS_suite_stateout_update_run.html !! -! ######################################################################################### subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & - dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & - dp, ozpl, qdiag3d, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & + imp_physics_fer_hires, epsq, errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -26,25 +22,14 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs integer, intent(in ) :: ntrac integer, intent(in ) :: imp_physics,imp_physics_fer_hires integer, intent(in ) :: ntiw, nqrimef - real(kind=kind_phys), intent(in ) :: dtp, epsq, con_1ovg - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs, prsl, dp - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl + real(kind=kind_phys), intent(in ) :: dtp, epsq + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt - logical, intent(in) :: qdiag3d - logical, intent(in) :: oz_phys_2015 - logical, intent(in) :: oz_phys_2006 - type(ty_ozphys), intent(in) :: ozphys - - ! Outputs (optional) - real(kind=kind_phys), intent(inout), dimension(:,:), optional :: & - do3_dt_prd, & ! Physics tendency: production and loss effect - do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect - do3_dt_temp, & ! Physics tendency: temperature effect - do3_dt_ohoz ! Physics tendency: overhead ozone effect ! Outputs - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0, oz0 + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -63,17 +48,6 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp - ! If using photolysis physics schemes, update (prognostic) gas concentrations using - ! updated state. - if (oz_phys_2015) then - call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & - do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) - endif - if (oz_phys_2006) then - call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & - do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) - endif - ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. if (imp_physics == imp_physics_fer_hires) then do k=1,levs diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta index f2f5d2281..8a0d784f2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = ../../hooks/machine.F,../../photochem/module_ozphys.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -37,34 +37,6 @@ type = real kind = kind_phys intent = in -[ozphys] - standard_name = dataset_for_ozone_physics - long_name = dataset for NRL ozone physics - units = mixed - dimensions = () - type = ty_ozphys - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[oz_phys_2015] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[oz_phys_2006] - standard_name = flag_for_nrl_2006_ozone_scheme - long_name = flag for new (2006) ozone physics - units = flag - dimensions = () - type = logical - intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -161,14 +133,6 @@ type = real kind = kind_phys intent = out -[oz0] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [ntiw] standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array long_name = tracer index for ice water @@ -205,74 +169,6 @@ type = real kind = kind_phys intent = in -[con_1ovg] - standard_name = one_divided_by_the_gravitational_acceleration - long_name = inverse of gravitational acceleration - units = s2 m-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) - type = real - kind = kind_phys - intent = in -[dp] - standard_name = air_pressure_difference_between_midlayers - long_name = difference between mid-layer pressures - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[do3_dt_prd] - standard_name = ozone_tendency_due_to_production_and_loss_rate - long_name = ozone tendency due to production and loss rate - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout - optional = True -[do3_dt_ozmx] - standard_name = ozone_tendency_due_to_ozone_mixing_ratio - long_name = ozone tendency due to ozone mixing ratio - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout - optional = True -[do3_dt_temp] - standard_name = ozone_tendency_due_to_temperature - long_name = ozone tendency due to temperature - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout - optional = True -[do3_dt_ohoz] - standard_name = ozone_tendency_due_to_overhead_ozone_column - long_name = ozone tendency due to overhead ozone column - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout - optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP 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..6a706456c --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 @@ -0,0 +1,211 @@ +!>\file ccpp_suite_simulator.F90 +!! 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..45d3dd4e0 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 @@ -0,0 +1,307 @@ +!>\file module_ccpp_suite_simulator.F90 +!! This module contains the type, base_physics_process, and supporting subroutines needed +!! by the ccpp suite simulator. + +module module_ccpp_suite_simulator + + 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 + +!> \section arg_table_base_physics_process Argument Table +!! \htmlinclude base_physics_process.html +!! +!! This type contains the meta information and data for each physics process. +!! + 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 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 index 835b468ff..797a1cd95 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 @@ -15,8 +15,7 @@ module scm_sfc_flux_spec CONTAINS !******************************************************************************************* -!! -!! \section arg_table_scm_sfc_flux_spec_init Argument Table +!> \section arg_table_scm_sfc_flux_spec_init Argument Table !! \htmlinclude scm_sfc_flux_spec_init.html !! subroutine scm_sfc_flux_spec_init(lheatstrg, errmsg, errflg) @@ -58,9 +57,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:) + integer, intent(inout) :: islmsk(:), use_lake_model(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) @@ -212,12 +211,12 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, do i = 1, im if ((wet(i) .or. icy(i)) .and. lakefrac(i) > 0.0_kind_phys) then if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > 1.0_kind_phys) then - use_lake_model(i) = .true. + use_lake_model(i) = 1 else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif enddo ! diff --git a/physics/photochem/module_h2ophys.F90 b/physics/photochem/module_h2ophys.F90 new file mode 100644 index 000000000..b94539d71 --- /dev/null +++ b/physics/photochem/module_h2ophys.F90 @@ -0,0 +1,237 @@ +! ######################################################################################### +!> \section arg_table_module_h2ophys Argument table +!! \htmlinclude module_h2ophys.html +!! +! ######################################################################################### +module module_h2ophys + use machine, only : kind_phys + implicit none + + public ty_h2ophys + +! ######################################################################################### +!> \section arg_table_ty_h2ophys Argument Table +!! \htmlinclude ty_h2ophys.html +!! +!> Derived type containing data and procedures needed by h2o photochemistry parameterization +!! *Note* All data field are ordered from surface-to-toa. +!! +! ######################################################################################### + type ty_h2ophys + integer :: nlat !< Number of latitudes. + integer :: nlev !< Number of vertical layers. + integer :: ntime !< Number of times. + integer :: ncf !< Number of coefficients. + real(kind_phys), allocatable :: lat(:) !< Latitude. + real(kind_phys), allocatable :: pres(:) !< Pressure levels. + real(kind_phys), allocatable :: ph2o(:) !< Natural log pressure of levels. + real(kind_phys), allocatable :: time(:) !< Time. + real(kind_phys), allocatable :: data(:,:,:,:) !< H20 forcing data (raw) + contains + procedure, public :: load + procedure, public :: setup + procedure, public :: update + procedure, public :: run + end type ty_h2ophys + +contains + ! ######################################################################################### + ! Procedure (type-bound) for loading data. + ! ######################################################################################### + function load(this, file, fileID) result (err_message) + class(ty_h2ophys), intent(inout) :: this + integer, intent(in) :: fileID + character(len=*), intent(in) :: file + character(len=128) :: err_message + integer :: i1, i2, i3, ierr + real(kind=4), dimension(:), allocatable :: lat4, pres4, time4, tempin + + ! initialize error message + err_message = "" + + ! Get dimensions from data file + open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian', iostat=ierr, iomsg=err_message) + if (ierr /= 0 ) return + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime + if (ierr /= 0 ) return + rewind(fileID) + + allocate (this%lat(this%nlat)) + allocate (this%pres(this%nlev)) + allocate (this%ph2o(this%nlev)) + allocate (this%time(this%ntime+1)) + allocate (this%data(this%nlat,this%nlev,this%ncf,this%ntime)) + + allocate(lat4(this%nlat), pres4(this%nlev), time4(this%ntime+1)) + read (fileID, iostat=ierr, iomsg=err_message) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + if (ierr /= 0 ) return + + ! Store + this%pres(:) = pres4(:) + this%ph2o(:) = log(100.0*this%pres(:)) ! from mb to ln(Pa) + this%lat(:) = lat4(:) + this%time(:) = time4(:) + deallocate(lat4, pres4, time4) + + allocate(tempin(this%nlat)) + do i1=1,this%ntime + do i2=1,this%ncf + do i3=1,this%nlev + read(fileID, iostat=ierr, iomsg=err_message) tempin + if (ierr /= 0 ) return + this%data(:,i3,i2,i1) = tempin(:) + enddo + enddo + enddo + deallocate(tempin) + close(fileID) + + end function load + + ! ######################################################################################### + ! Procedure (type-bound) for setting up interpolation indices between data-grid and + ! model-grid. + ! ######################################################################################### + subroutine setup(this, lat, idx1, idx2, idxh) + class(ty_h2ophys), intent(in) :: this + real(kind_phys), intent(in) :: lat(:) + integer, intent(out) :: idx1(:), idx2(:) + real(kind_phys), intent(out) :: idxh(:) + integer :: i,j + + do j=1,size(lat) + idx2(j) = this%nlat + 1 + do i=1,this%nlat + if (lat(j) < this%lat(i)) then + idx2(j) = i + exit + endif + enddo + idx1(j) = max(idx2(j)-1,1) + idx2(j) = min(idx2(j),this%nlat) + if (idx2(j) .ne. idx1(j)) then + idxh(j) = (lat(j) - this%lat(idx1(j))) / (this%lat(idx2(j)) - this%lat(idx1(j))) + else + idxh(j) = 1.0 + endif + enddo + + end subroutine setup + + ! ######################################################################################### + ! Procedure (type-bound) for updating data. + ! ######################################################################################### + subroutine update(this, idx1, idx2, idxh, rjday, idxt1, idxt2, h2opl) + class(ty_h2ophys), intent(in) :: this + integer, intent(in) :: idx1(:), idx2(:) + real(kind_phys), intent(in) :: idxh(:) + real(kind_phys), intent(in) :: rjday + integer, intent(in) :: idxt1, idxt2 + real(kind_phys), intent(out) :: h2opl(:,:,:) + integer :: nc, l, j, j1, j2 + real(kind_phys) :: tem, tx1, tx2 + + tx1 = (this%time(idxt2) - rjday) / (this%time(idxt2) - this%time(idxt1)) + tx2 = 1.0 - tx1 + + do nc=1,this%ncf + do l=1,this%nlev + do j=1,size(h2opl(:,1,1)) + j1 = idx1(j) + j2 = idx2(j) + tem = 1.0 - idxh(j) + h2opl(j,l,nc) = tx1*(tem*this%data(j1,l,nc,idxt1)+idxh(j)*this%data(j2,l,nc,idxt1)) & + + tx2*(tem*this%data(j1,l,nc,idxt2)+idxh(j)*this%data(j2,l,nc,idxt2)) + enddo + enddo + enddo + + end subroutine update + + ! ######################################################################################### + ! Procedure (type-bound) for NRL stratospheric h2o photochemistry physics. + ! ######################################################################################### + subroutine run(this, dt, p, h2opltc, h2o) + class(ty_h2ophys), intent(in) :: this + real(kind_phys), intent(in) :: & + dt ! Model timestep (sec) + real(kind_phys), intent(in), dimension(:,:) :: & + p ! Model Pressure (Pa) + real(kind_phys), intent(in), dimension(:,:,:) :: & + h2opltc ! h2o forcing data + real(kind_phys), intent(inout), dimension(:,:) :: & + h2o ! h2o concentration (updated) + + integer :: nCol, nLev, iCol, iLev, iCf, kmax, kmin, k + logical, dimension(size(p,1)) :: flg + real(kind_phys) :: pmax, pmin, temp + real(kind_phys), dimension(size(p,1)) :: wk1, wk2, wk3, h2oib + real(kind_phys), dimension(size(p,1),this%ncf) :: pltc + real(kind_phys), parameter :: prsmax=10000.0, pmaxl=log(prsmax) + + ! Dimensions + nCol = size(p,1) + nLev = size(p,2) + + do iLev=1,nLev + pmin = 1.0e10 + pmax = -1.0e10 + do iCol=1,nCol + wk1(iCol) = log(p(iCol,iLev)) + pmin = min(wk1(iCol), pmin) + pmax = max(wk1(iCol), pmax) + pltc(iCol,:) = 0._kind_phys + enddo + if (pmin < pmaxl) then + kmax = 1 + kmin = 1 + do k=1,this%nlev-1 + if (pmin < this%ph2o(k)) kmax = k + if (pmax < this%ph2o(k)) kmin = k + enddo + + do k=kmin,kmax + temp = 1.0 / (this%ph2o(k) - this%ph2o(k+1)) + do iCol=1,nCol + flg(iCol) = .false. + if (wk1(iCol) < this%ph2o(k) .and. wk1(iCol) >= this%ph2o(k+1)) then + flg(iCol) = .true. + wk2(iCol) = (wk1(iCol) - this%ph2o(k+1)) * temp + wk3(iCol) = 1.0 - wk2(iCol) + endif + enddo + do iCf=1,this%ncf + do iCol=1,nCol + if (flg(iCol)) then + pltc(iCol,iCf) = wk2(iCol) * h2opltc(iCol,k,iCf) + wk3(iCol) * h2opltc(iCol,k+1,iCf) + endif + enddo + enddo + enddo + + do iCf=1,this%ncf + do iCol=1,nCol + if (wk1(iCol) < this%ph2o(this%nlev)) then + pltc(iCol,iCf) = h2opltc(iCol,this%nlev,iCf) + endif + if (wk1(iCol) >= this%ph2o(1)) then + pltc(iCol,iCf) = h2opltc(iCol,1,iCf) + endif + enddo + enddo + endif + + do iCol=1,nCol + if (p(iCol,iLev) < prsmax .and. pltc(iCol,2) /= 0.0) then + h2oib(iCol) = h2o(iCol,iLev) + temp = 1.0 / pltc(iCol,2) + h2o(iCol,iLev) = (h2oib(iCol) + (pltc(iCol,1)+pltc(iCol,3)*temp)*dt) / (1.0 + temp*dt) + endif + enddo + enddo + + + return + end subroutine run + +end module module_h2ophys diff --git a/physics/photochem/module_h2ophys.meta b/physics/photochem/module_h2ophys.meta new file mode 100644 index 000000000..030050acb --- /dev/null +++ b/physics/photochem/module_h2ophys.meta @@ -0,0 +1,25 @@ +[ccpp-table-properties] + name = ty_h2ophys + type = ddt + dependencies = + +[ccpp-arg-table] + name = ty_h2ophys + type = ddt + +######################################################################## +[ccpp-table-properties] + name = module_h2ophys + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = module_h2ophys + type = module +[ty_h2ophys] + standard_name = ty_h2ophys + long_name = definition of type ty_h2ophys + units = DDT + dimensions = () + type = ty_h2ophys + \ No newline at end of file diff --git a/physics/photochem/module_ozphys.F90 b/physics/photochem/module_ozphys.F90 index 898dee921..b7b9c92f0 100644 --- a/physics/photochem/module_ozphys.F90 +++ b/physics/photochem/module_ozphys.F90 @@ -1,10 +1,12 @@ +!>\file module_ozphys.F90 +!! ! ######################################################################################### !> \section arg_table_module_ozphys Argument table !! \htmlinclude module_ozphys.html !! ! !> The operational GFS currently parameterizes ozone production and destruction based on -!! monthly mean coefficients (\c global_o3prdlos.f77) provided by Naval Research Laboratory +!! monthly mean coefficients ( global_o3prdlos.f77) provided by Naval Research Laboratory !! through CHEM2D chemistry model (McCormack et al. (2006) \cite mccormack_et_al_2006). !! !! There are two implementations of this parameterization within this module. @@ -33,7 +35,7 @@ !! update_o3clim() -> run_o3clim() -> radiation() -> physics... !! !!\author June 2015 - Shrinivas Moorthi -!!\modified Sep 2023 - Dustin Swales +!! - Sep 2023 - Dustin Swales !! ! ######################################################################################### module module_ozphys @@ -47,7 +49,7 @@ module module_ozphys !> \section arg_table_ty_ozphys Argument Table !! \htmlinclude ty_ozphys.html !! -!> Derived type containing data and procedures needed by ozone photochemistry parameterization +!! Derived type containing data and procedures needed by ozone photochemistry parameterization !! *Note* All data field are ordered from surface-to-toa. !! ! ######################################################################################### @@ -87,9 +89,8 @@ module module_ozphys end type ty_ozphys contains - ! ######################################################################################### - ! Procedure (type-bound) for loading data for prognostic ozone. - ! ######################################################################################### + +!> Procedure (type-bound) for loading data for prognostic ozone. function load_o3prog(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: fileID @@ -141,11 +142,8 @@ function load_o3prog(this, file, fileID) result (err_message) end function load_o3prog - ! ######################################################################################### - ! Procedure (type-bound) for setting up interpolation indices between data-grid and - ! model-grid. - ! Called once during initialization - ! ######################################################################################### +!> Procedure (type-bound) for setting up interpolation indices between data-grid and +!! model-grid. Called once during initialization subroutine setup_o3prog(this, lat, idx1, idx2, idxh) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: lat(:) @@ -172,9 +170,7 @@ subroutine setup_o3prog(this, lat, idx1, idx2, idxh) end subroutine setup_o3prog - ! ######################################################################################### - ! Procedure (type-bound) for updating data used in prognostic ozone scheme. - ! ######################################################################################### +!> Procedure (type-bound) for updating data used in prognostic ozone scheme. subroutine update_o3prog(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) class(ty_ozphys), intent(in) :: this integer, intent(in) :: idx1(:), idx2(:) @@ -205,8 +201,9 @@ end subroutine update_o3prog ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2015). ! ######################################################################################### - subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & + subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) @@ -220,7 +217,6 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_ ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - logical, intent(in) :: do_diag real(kind_phys), intent(inout), dimension(:,:), optional :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect @@ -305,12 +301,11 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_ enddo ! Diagnostics (optional) - if (do_diag) then - do3_dt_prd(:,iLev) = prod(:,1) * dt - do3_dt_ozmx(:,iLev) = prod(:,2) * (oz(:,iLev) - prod(:,6)) * dt - do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt - do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt - endif + if (present(do3_dt_prd)) do3_dt_prd(:,iLev) = prod(:,1) * dt + if (present(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = prod(:,2) * (oz(:,iLev) - prod(:,6)) * dt + if (present(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt + if (present(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + enddo return @@ -319,8 +314,9 @@ end subroutine run_o3prog_2015 ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2006). ! ######################################################################################### - subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_dt_prd, & + subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) @@ -334,8 +330,7 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_ ozpl ! Ozone forcing data real(kind_phys), intent(inout), dimension(:,:) :: & oz ! Ozone concentration updated by physics - logical, intent(in) :: do_diag - real(kind_phys), intent(inout), dimension(:,:) :: & + real(kind_phys), intent(inout), dimension(:,:), optional :: & do3_dt_prd, & ! Physics tendency: production and loss effect do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect do3_dt_temp, & ! Physics tendency: temperature effect @@ -431,20 +426,17 @@ subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do_diag, do3_ endif ! Diagnostics (optional) - if (do_diag) then - do3_dt_prd(:,iLev) = prod(:,1)*dt - do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) - do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt - do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt - endif + if (present(do3_dt_prd)) do3_dt_prd(:,iLev) = prod(:,1)*dt + if (present(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + if (present(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt + if (present(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + enddo return end subroutine run_o3prog_2006 - ! ######################################################################################### - ! Procedure (type-bound) for NRL updating climotological ozone. - ! ######################################################################################### +!> Procedure (type-bound) for NRL updating climotological ozone. subroutine run_o3clim(this, lat, prslk, con_pi, oz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & @@ -522,9 +514,7 @@ subroutine run_o3clim(this, lat, prslk, con_pi, oz) return end subroutine run_o3clim - ! ######################################################################################### - ! Procedure (type-bound) for loading data for climotological ozone. - ! ######################################################################################### +!> Procedure (type-bound) for loading data for climotological ozone. function load_o3clim(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: fileID @@ -608,10 +598,8 @@ function load_o3clim(this, file, fileID) result (err_message) end function load_o3clim - ! ######################################################################################### - ! Procedure (type-bound) for updating temporal interpolation index when using climotological - ! ozone - ! ######################################################################################### +!> Procedure (type-bound) for updating temporal interpolation index when using climotological +!! ozone subroutine update_o3clim(this, imon, iday, ihour, loz1st) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: imon, iday, ihour