From ce7fde9a21da438a87e54e011540b973b2d13d82 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 27 Feb 2024 10:52:16 -0700 Subject: [PATCH 01/11] Update physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.* to use chunked GFS DDTs --- .../UFS_SCM_NEPTUNE/GFS_debug.F90 | 154 +++++----- .../UFS_SCM_NEPTUNE/GFS_debug.meta | 266 ++++++++++++++++-- 2 files changed, 328 insertions(+), 92 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index ed26b795f..0a7a8983d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -303,6 +303,16 @@ module GFS_diagtoscreen use print_var_chksum, only: print_var + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type + + use CCPP_typedefs, only: GFS_interstitial_type + implicit none private @@ -314,66 +324,70 @@ module GFS_diagtoscreen !> \section arg_table_GFS_diagtoscreen_init Argument Table !! \htmlinclude GFS_diagtoscreen_init.html !! - subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_init !> \section arg_table_GFS_diagtoscreen_timestep_init Argument Table !! \htmlinclude GFS_diagtoscreen_timestep_init.html !! - subroutine GFS_diagtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_timestep_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_timestep_init @@ -390,12 +404,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #ifdef _OPENMP use omp_lib #endif - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type implicit none @@ -619,7 +627,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%in_nm' , Tbd%in_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%ccn_nm' , Tbd%ccn_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aer_nm' , Tbd%aer_nm) - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv' , Tbd%cactiv) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv_m' , Tbd%cactiv_m) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aod_gf' , Tbd%aod_gf) @@ -877,13 +885,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) - if (Model%use_med_flux) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfcino_cpl ', Coupling%dusfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfcino_cpl ', Coupling%dvsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfcino_cpl ', Coupling%dtsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfcino_cpl ', Coupling%dqsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ulwsfcino_cpl', Coupling%ulwsfcino_cpl ) - end if end if if (Model%cplchm) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rainc_cpl', Coupling%rainc_cpl) @@ -971,6 +972,17 @@ module GFS_interstitialtoscreen use print_var_chksum, only: print_var + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type + + use CCPP_typedefs, only: GFS_interstitial_type + + implicit none private @@ -982,16 +994,23 @@ module GFS_interstitialtoscreen !> \section arg_table_GFS_interstitialtoscreen_init Argument Table !! \htmlinclude GFS_interstitialtoscreen_init.html !! - subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_interstitialtoscreen_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1003,11 +1022,9 @@ subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, err errmsg = '' errflg = 0 - do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + call GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial(i), & size(Interstitial), -999, errmsg, errflg) end do @@ -1016,16 +1033,23 @@ end subroutine GFS_interstitialtoscreen_init !> \section arg_table_GFS_interstitialtoscreen_timestep_init Argument Table !! \htmlinclude GFS_interstitialtoscreen_timestep_init.html !! - subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_interstitialtoscreen_timestep_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1039,9 +1063,8 @@ subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, er do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + call GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial(i), & size(Interstitial), -999, errmsg, errflg) end do @@ -1060,14 +1083,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup #ifdef _OPENMP use omp_lib #endif - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type - implicit none !--- interface variables @@ -1293,7 +1308,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_ice ', Interstitial%qss_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_land ', Interstitial%qss_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_water ', Interstitial%qss_water ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%radar_reset ', Interstitial%radar_reset ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raddt ', Interstitial%raddt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincd ', Interstitial%raincd ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincs ', Interstitial%raincs ) @@ -1322,8 +1336,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmafrac ', Interstitial%sigmafrac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmatot ', Interstitial%sigmatot ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowc ', Interstitial%snowc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_ice ', Interstitial%snowd_ice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_land ', Interstitial%snowd_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snohf ', Interstitial%snohf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmt ', Interstitial%snowmt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress ', Interstitial%stress ) @@ -1535,7 +1547,7 @@ module GFS_checkland !! \htmlinclude GFS_checkland_run.html !! subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & + flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & dry, icy, wet, lake, ocean, oceanfrac, landfrac, lakefrac, slmsk, islmsk, & zorl, zorlw, zorll, zorli, fice, errmsg, errflg ) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index 10eb43671..0d12b2bbb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -9,17 +9,73 @@ type = scheme [Model] standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type in FV3 + long_name = instance of derived type GFS_control_type units = DDT dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -55,12 +111,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -213,12 +325,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -254,12 +422,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads From 6f6175acdc789f1eba3aa2e455019423d453b997 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 12 May 2024 20:23:05 -0600 Subject: [PATCH 02/11] Update MPI communicator in GFS_debug.F90 --- .../UFS_SCM_NEPTUNE/GFS_debug.F90 | 22 ++++++++----------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index e4caf708b..cdd3d8e2b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -426,7 +426,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !--- local variables integer :: impi, iomp, ierr, n, idtend, iprocess, itracer - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize ! Initialize CCPP error handling variables @@ -434,13 +434,11 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, errflg = 0 #ifdef MPI - mpicomm = Model%communicator mpirank = Model%me mpisize = Model%ntasks #else mpirank = 0 mpisize = 1 - mpicomm = 0 #endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() @@ -454,7 +452,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif do impi=0,mpisize-1 @@ -952,7 +950,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #endif end do #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end do @@ -960,7 +958,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end subroutine GFS_diagtoscreen_run @@ -1104,7 +1102,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !--- local variables integer :: impi, iomp, ierr - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize integer :: istart, iend, kstart, kend @@ -1113,13 +1111,11 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup errflg = 0 #ifdef MPI - mpicomm = Model%communicator mpirank = Model%me - call MPI_COMM_SIZE(mpicomm, mpisize, ierr) + call MPI_COMM_SIZE(Model%communicator, mpisize, ierr) #else mpirank = 0 mpisize = 1 - mpicomm = 0 #endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() @@ -1133,7 +1129,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif do impi=0,mpisize-1 @@ -1482,7 +1478,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup #endif end do #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end do @@ -1490,7 +1486,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end subroutine GFS_interstitialtoscreen_run From 4ed1b4fdf6dd89005c4cd0fac4700f1b2c5729e7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 3 Jun 2024 16:54:21 -0600 Subject: [PATCH 03/11] Bug fixes in Thompson MP and CLM Lake found by Dusan --- physics/MP/Thompson/module_mp_thompson.F90 | 2 +- physics/MP/Thompson/mp_thompson.F90 | 2 +- physics/SFC_Models/Lake/CLM/clm_lake.f90 | 3 ++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/MP/Thompson/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 index aa1361c3b..3fc27ca4a 100644 --- a/physics/MP/Thompson/module_mp_thompson.F90 +++ b/physics/MP/Thompson/module_mp_thompson.F90 @@ -1048,7 +1048,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & INTEGER, INTENT(IN) :: rand_perturb_on, kme_stoch, n_var_spp REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: rand_pert REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: spp_prt_list - REAL, DIMENSION(:), INTENT(IN) :: spp_stddev_cutoff + REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: spp_stddev_cutoff CHARACTER(len=10), DIMENSION(:), INTENT(IN), OPTIONAL :: spp_var_list INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 3b99deec1..444790324 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -413,7 +413,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(in), optional :: spp_wts_mp(:,:) real(kind_phys), intent(in), optional :: spp_prt_list(:) character(len=10), intent(in), optional :: spp_var_list(:) - real(kind_phys), intent(in) :: spp_stddev_cutoff(:) + real(kind_phys), intent(in), optional :: spp_stddev_cutoff(:) logical, intent (in) :: cplchm ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 8686221fa..94ad9d815 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -5388,7 +5388,8 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd - REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi + REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0 + REAL(kind_phys), DIMENSION(IM,KM+1), INTENT(IN) :: prsi real(kind_phys), intent(in) :: lakedepth_default real(kind_phys), dimension(IM),intent(inout) :: clm_lakedepth From ddbd127f79a3aa9c191220ac98f78a416e2c6cec Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 12 Jun 2024 22:12:12 +0000 Subject: [PATCH 04/11] Refactor h2o photochemistry scheme following the ozone photochemistry scheme. --- CODEOWNERS | 4 +- .../UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 73 ++++++ .../UFS_SCM_NEPTUNE/GFS_photochemistry.meta | 161 ++++++++++++ .../GFS_phys_time_vary.fv3.F90 | 50 +--- .../GFS_phys_time_vary.fv3.meta | 17 +- .../GFS_phys_time_vary.scm.F90 | 43 +--- .../GFS_phys_time_vary.scm.meta | 24 +- .../GFS_suite_stateout_update.F90 | 36 +-- .../GFS_suite_stateout_update.meta | 92 +------ physics/photochem/h2o_def.f | 22 -- physics/photochem/h2o_def.meta | 28 --- physics/photochem/h2ointerp.f90 | 199 --------------- physics/photochem/h2ophys.f | 149 ----------- physics/photochem/h2ophys.meta | 127 ---------- physics/photochem/module_h2ophys.F90 | 238 ++++++++++++++++++ physics/photochem/module_h2ophys.meta | 24 ++ 16 files changed, 560 insertions(+), 727 deletions(-) create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 create mode 100644 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta delete mode 100644 physics/photochem/h2o_def.f delete mode 100644 physics/photochem/h2o_def.meta delete mode 100644 physics/photochem/h2ointerp.f90 delete mode 100644 physics/photochem/h2ophys.f delete mode 100644 physics/photochem/h2ophys.meta create mode 100644 physics/photochem/module_h2ophys.F90 create mode 100644 physics/photochem/module_h2ophys.meta diff --git a/CODEOWNERS b/CODEOWNERS index 99d6697f2..eccf83758 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -128,9 +128,7 @@ physics/SFC_Models/SeaIce/CICE/sfc_cice.* @wd physics/SFC_Models/SeaIce/CICE/sfc_sice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales physics/hooks/machine.* @grantfirl @Qingfu-Liu @dustinswales physics/hooks/physcons.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/photochem/h2o_def.* @grantfirl @Qingfu-Liu @dustinswales -physics/photochem/h2ointerp.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/photochem/h2ophys.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/photochem/module_h2ophys.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales physics/photochem/module_ozphys.* @dustinswales @grantfirl @Qingfu-Liu @dustinswales physics/smoke_dust/* @haiqinli @grantfirl @Qingfu-Liu @dustinswales physics/tools/funcphys.f90 @grantfirl @Qingfu-Liu @dustinswales 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..08bedf6b5 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -0,0 +1,73 @@ +! ######################################################################################### +!> \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_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, 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) + 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 h2o photochemistry? + type(ty_ozphys), intent(in) :: & + ozphys ! DDT with ozone photochemistry scheme. + type(ty_h2ophys), intent(in) :: & + h2ophys ! DDT with h2o photochemistry scheme. + + ! 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(:,:) :: & + 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_update 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..526910fec --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -0,0 +1,161 @@ +######################################################################## +[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 + 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 = 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 = out +[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 ea9beaf90..5c3d1fac5 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 @@ -734,7 +710,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 @@ -765,6 +741,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 @@ -812,7 +789,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) @@ -895,12 +872,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 @@ -992,12 +966,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..89b1ba87c 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 @@ -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, & @@ -104,6 +102,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 +188,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 @@ -254,7 +234,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_h2oprog(xlat_d, jindx1_h, jindx2_h, ddy_h) endif !> - Call setindxaer() to initialize aerosols data @@ -633,7 +613,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 +648,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 +751,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_h2oprog(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif !> - Call ciinterpol() to make IN and CCN data interpolation @@ -859,12 +838,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..72f383b56 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 @@ -1441,6 +1454,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..057c50d1e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -6,9 +6,9 @@ !! 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 @@ -16,9 +16,9 @@ module GFS_suite_stateout_update !! ! ######################################################################################### 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, & + dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, 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) + errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -27,24 +27,13 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs 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 ), dimension(:,:) :: tgrs, ugrs, vgrs, prsl + 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 +52,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..4153befb9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -2,8 +2,8 @@ [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] name = GFS_suite_stateout_update_run @@ -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 @@ -221,58 +185,6 @@ 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/photochem/h2o_def.f b/physics/photochem/h2o_def.f deleted file mode 100644 index 72748a613..000000000 --- a/physics/photochem/h2o_def.f +++ /dev/null @@ -1,22 +0,0 @@ -!>\file h2o_def.f -!! This file contains array definition in H2O scheme. - -!>\ingroup mod_GFS_phys_time_vary -!! This module defines arrays in H2O scheme. - module h2o_def - -!> \section arg_table_h2o_def -!! \htmlinclude h2o_def.html -!! - - use machine , only : kind_phys - implicit none - - integer, parameter :: kh2opltc=29 - - integer latsh2o, levh2o, timeh2o, h2o_coeff - real (kind=kind_phys), allocatable :: h2o_lat(:), h2o_pres(:) - &, h2o_time(:) - real (kind=kind_phys), allocatable :: h2oplin(:,:,:,:) - - end module h2o_def diff --git a/physics/photochem/h2o_def.meta b/physics/photochem/h2o_def.meta deleted file mode 100644 index 92e1d61bd..000000000 --- a/physics/photochem/h2o_def.meta +++ /dev/null @@ -1,28 +0,0 @@ -[ccpp-table-properties] - name = h2o_def - type = module - dependencies = ../hooks/machine.F - -[ccpp-arg-table] - name = h2o_def - type = module - -[levh2o] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data - units = count - dimensions = () - type = integer -[h2o_coeff] - standard_name = number_of_coefficients_in_h2o_forcing_data - long_name = number of coefficients in h2o forcing data - units = index - dimensions = () - type = integer -[h2o_pres] - standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels in Pa - units = 1 - dimensions = (vertical_dimension_of_h2o_forcing_data) - type = real - kind = kind_phys diff --git a/physics/photochem/h2ointerp.f90 b/physics/photochem/h2ointerp.f90 deleted file mode 100644 index f5a1f36c6..000000000 --- a/physics/photochem/h2ointerp.f90 +++ /dev/null @@ -1,199 +0,0 @@ -!>\file h2ointerp.f90 -!! This file contains subroutines of reading and interpolating h2o -!! coefficients. - -!>\ingroup mod_GFS_phys_time_vary -!> This module contains subroutines of reading and interpolating -!! h2o coefficients. -module h2ointerp - - implicit none - - private - - public :: read_h2odata, setindxh2o, h2ointerpol - -contains - - subroutine read_h2odata (h2o_phys, me, master) - use machine, only: kind_phys - use h2o_def -!--- in/out - logical, intent(in) :: h2o_phys - integer, intent(in) :: me - integer, intent(in) :: master -!--- locals - integer :: i, n, k - real(kind=4), allocatable, dimension(:) :: h2o_lat4, h2o_pres4 - real(kind=4), allocatable, dimension(:) :: h2o_time4, tempin - - if (.not. h2o_phys) then - latsh2o = 1 - levh2o = 1 - h2o_coeff = 1 - timeh2o = 1 - - return - endif - - open(unit=kh2opltc,file='global_h2oprdlos.f77', form='unformatted', convert='big_endian') - -!--- read in indices -!--- - read (kh2opltc) h2o_coeff, latsh2o, levh2o, timeh2o - if (me == master) then - write(*,*) 'Reading in h2odata from global_h2oprdlos.f77 ' - write(*,*) ' h2o_coeff = ', h2o_coeff - write(*,*) ' latsh2o = ', latsh2o - write(*,*) ' levh2o = ', levh2o - write(*,*) ' timeh2o = ', timeh2o - endif - -!--- read in data -!--- h2o_lat - latitude of data (-90 to 90) -!--- h2o_pres - vertical pressure level (mb) -!--- h2o_time - time coordinate (days) -!--- - allocate (h2o_lat(latsh2o), h2o_pres(levh2o),h2o_time(timeh2o+1)) - allocate (h2o_lat4(latsh2o), h2o_pres4(levh2o),h2o_time4(timeh2o+1)) - rewind (kh2opltc) - read (kh2opltc) h2o_coeff, latsh2o, levh2o, timeh2o, h2o_lat4, h2o_pres4, h2o_time4 - h2o_pres(:) = h2o_pres4(:) -!--- convert pressure levels from mb to ln(Pa) - h2o_pres(:) = log(100.0*h2o_pres(:)) - h2o_lat(:) = h2o_lat4(:) - h2o_time(:) = h2o_time4(:) - deallocate (h2o_lat4, h2o_pres4, h2o_time4) - -!--- read in h2oplin which is in order of (lattitudes, water levels, coeff number, time) -!--- assume latitudes is on a uniform gaussian grid -!--- - allocate (tempin(latsh2o)) - allocate (h2oplin(latsh2o,levh2o,h2o_coeff,timeh2o)) - DO i=1,timeh2o - do n=1,h2o_coeff - DO k=1,levh2o - READ(kh2opltc) tempin - h2oplin(:,k,n,i) = tempin(:) - ENDDO - enddo - ENDDO - deallocate (tempin) - - close(kh2opltc) - - end subroutine read_h2odata -! -!********************************************************************** -! - subroutine setindxh2o(npts,dlat,jindx1,jindx2,ddy) -! -! May 2015 Shrinivas Moorthi - Prepare for H2O interpolation -! - use machine, only: kind_phys - use h2o_def, only: jh2o => latsh2o, h2o_lat, h2o_time -! - implicit none -! - integer npts - integer, dimension(npts) :: jindx1, jindx2 - real(kind=kind_phys) :: dlat(npts),ddy(npts) -! - integer i,j,lat -! - do j=1,npts - jindx2(j) = jh2o + 1 - do i=1,jh2o - if (dlat(j) < h2o_lat(i)) then - jindx2(j) = i - exit - endif - enddo - jindx1(j) = max(jindx2(j)-1,1) - jindx2(j) = min(jindx2(j),jh2o) - if (jindx2(j) /= jindx1(j)) then - ddy(j) = (dlat(j) - h2o_lat(jindx1(j))) & - / (h2o_lat(jindx2(j)) - h2o_lat(jindx1(j))) - else - ddy(j) = 1.0 - endif -! print *,' j=',j,' dlat=',dlat(j),' jindx12=',jindx1(j), & -! jindx2(j),' h2o_lat=',h2o_lat(jindx1(j)), & -! h2o_lat(jindx2(j)),' ddy=',ddy(j) - enddo - - return - end subroutine setindxh2o -! -!********************************************************************** -! - subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy) -! -! May 2015 Shrinivas Moorthi - Prepare for H2O interpolation -! - use machine , only : kind_phys, kind_dbl_prec - use h2o_def - implicit none - integer j,j1,j2,l,npts,nc,n1,n2 - real(kind=kind_phys) fhour,tem, tx1, tx2 -! - - integer jindx1(npts), jindx2(npts) - integer me,idate(4) - integer idat(8),jdat(8) -! - real(kind=kind_phys) ddy(npts) - real(kind=kind_phys) h2oplout(npts,levh2o,h2o_coeff) - real(kind=kind_phys) rjday - real(kind=kind_dbl_prec) rinc(5) - integer jdow, jdoy, jday -! - idat = 0 - idat(1) = idate(4) - idat(2) = idate(2) - idat(3) = idate(3) - idat(5) = idate(1) - rinc = 0. - rinc(2) = fhour - CALL W3MOVDAT(RINC,IDAT,JDAT) -! - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - rjday = jdoy + jdat(5) / 24. - if (rjday < h2o_time(1)) rjday = rjday+365. -! - n2 = timeh2o + 1 - do j=2,timeh2o - if (rjday < h2o_time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 -! -! if (me .eq. 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday -! &,'h2o_time=',h2o_time(n1),h2o_time(n2) -! - tx1 = (h2o_time(n2) - rjday) / (h2o_time(n2) - h2o_time(n1)) - tx2 = 1.0 - tx1 - if (n2 > timeh2o) n2 = n2 - timeh2o -! - do nc=1,h2o_coeff - do l=1,levh2o - do j=1,npts - j1 = jindx1(j) - j2 = jindx2(j) - tem = 1.0 - ddy(j) - h2oplout(j,l,nc) = & - tx1*(tem*h2oplin(j1,l,nc,n1)+ddy(j)*h2oplin(j2,l,nc,n1)) & - + tx2*(tem*h2oplin(j1,l,nc,n2)+ddy(j)*h2oplin(j2,l,nc,n2)) - enddo - enddo - enddo -! - return - end subroutine h2ointerpol - -end module h2ointerp diff --git a/physics/photochem/h2ophys.f b/physics/photochem/h2ophys.f deleted file mode 100644 index f46868e58..000000000 --- a/physics/photochem/h2ophys.f +++ /dev/null @@ -1,149 +0,0 @@ -!>\file h2ophys.f -!! This file include NRL H2O physics for stratosphere and mesosphere. - -!> This module contains the CCPP-compliant H2O physics for stratosphere and mesosphere. - module h2ophys - - implicit none - - private - - public :: h2ophys_init, h2ophys_run - - contains - - subroutine h2ophys_init(h2o_phys, errmsg, errflg) - - implicit none - logical, intent(in) :: h2o_phys - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not.h2o_phys) then - write (errmsg,'(*(a))') 'Logic error: h2o_phys == .false.' - errflg = 1 - return - endif - end subroutine h2ophys_init - -!>\defgroup GFS_h2ophys GFS Water Vapor Photochemical Module -!> This subroutine is NRL H2O physics for stratosphere and mesosphere. -!! \section arg_table_h2ophys_run Argument Table -!! \htmlinclude h2ophys_run.html -!! -!! \section genal_h2ophys GFS H2O Physics Scheme General Algorithm -!> @{ - subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & - & h2opltc, h2o_coeff, me, & - & errmsg, errflg) -! -! May 2015 - Shrinivas Moorthi - Adaptation of NRL H2O physics for -! stratosphere and mesosphere -! -! this code assumes that both prsl and ph2o are from bottom to top -! as are all other variables -! - use machine , only : kind_phys - implicit none -! interface variables - integer, intent(in) :: im, levs, kh2o, h2o_coeff, me - real(kind=kind_phys), intent(in) :: dt - real(kind=kind_phys), intent(inout) :: h2o(:,:) - real(kind=kind_phys), intent(in) :: ph2o(:) - real(kind=kind_phys), intent(in) :: prsl(:,:) - real(kind=kind_phys), intent(in) :: h2opltc(:,:,:) - !real(kind=kind_phys), intent(inout) :: h2op(im,levs,h2o_coeff) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg -! local variables - integer k,kmax,kmin,l,i,j - logical flg(im) - real(kind=kind_phys) pmax, pmin, tem, temp - real(kind=kind_phys) wk1(im), wk2(im), wk3(im), pltc(im,h2o_coeff) - &, h2oib(im) - real, parameter :: prsmax=10000.0, pmaxl=log(prsmax) -! -! initialize CCPP error handling variables - errmsg = '' - errflg = 0 -! -! write(1000+me,*)' in h2ophys im=', im, levs, kh2o, dt - do l=1,levs - pmin = 1.0e10 - pmax = -1.0e10 -! - do i=1,im - wk1(i) = log(prsl(i,l)) - pmin = min(wk1(i), pmin) - pmax = max(wk1(i), pmax) - pltc(i,:) = 0.0 - enddo - if (pmin < pmaxl) then - kmax = 1 - kmin = 1 - do k=1,kh2o-1 - if (pmin < ph2o(k)) kmax = k - if (pmax < ph2o(k)) kmin = k - enddo -! - do k=kmin,kmax - temp = 1.0 / (ph2o(k) - ph2o(k+1)) - do i=1,im - flg(i) = .false. - if (wk1(i) < ph2o(k) .and. wk1(i) >= ph2o(k+1)) then - flg(i) = .true. - wk2(i) = (wk1(i) - ph2o(k+1)) * temp - wk3(i) = 1.0 - wk2(i) - endif - enddo - do j=1,h2o_coeff - do i=1,im - if (flg(i)) then - pltc(i,j) = wk2(i) * h2opltc(i,k,j) - & + wk3(i) * h2opltc(i,k+1,j) - endif - enddo - enddo - enddo -! - do j=1,h2o_coeff - do i=1,im - if (wk1(i) < ph2o(kh2o)) then - pltc(i,j) = h2opltc(i,kh2o,j) - endif - if (wk1(i) >= ph2o(1)) then - pltc(i,j) = h2opltc(i,1,j) - endif - enddo - enddo - endif - do i=1,im - if (prsl(i,l) < prsmax .and. pltc(i,2) /= 0.0) then - h2oib(i) = h2o(i,l) ! no filling - tem = 1.0 / pltc(i,2) ! 1/teff - h2o(i,l) = (h2oib(i) + (pltc(i,1)+pltc(i,3)*tem)*dt) - & / (1.0 + tem*dt) - endif - -! if (i == 1) write(1000+me,*)' h2oib=',h2oib(i),' pltc1=', -! &pltc(i,1),' pltc2=', pltc(i,2),' tem=',tem ,' dt=',dt -! &,' l=',l - enddo -! -! if (ldiag3d) then ! h2o change diagnostics -! do i=1,im -! h2op(i,l,1) = h2op(i,l,1) + pltc(i,1)*dt -! h2op(i,l,2) = h2op(i,l,2) + (h2oo(i,l) - h2oib(i)) -! enddo -! endif - enddo ! vertical loop -! - return - end subroutine h2ophys_run -!> @} - - end module h2ophys diff --git a/physics/photochem/h2ophys.meta b/physics/photochem/h2ophys.meta deleted file mode 100644 index 9e9b03647..000000000 --- a/physics/photochem/h2ophys.meta +++ /dev/null @@ -1,127 +0,0 @@ -[ccpp-table-properties] - name = h2ophys - type = scheme - dependencies = ../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = h2ophys_init - type = scheme -[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 = h2ophys_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_layer_dimension - long_name = number of vertical layers - units = count - dimensions = () - type = integer - intent = in -[kh2o] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data - units = count - dimensions = () - type = integer - intent = in -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[h2o] - 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 -[ph2o] - standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels - units = 1 - dimensions = (vertical_dimension_of_h2o_forcing_data) - 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 -[h2opltc] - 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 -[h2o_coeff] - standard_name = number_of_coefficients_in_h2o_forcing_data - long_name = number of coefficients in h2o forcing data - units = index - dimensions = () - type = integer - intent = in -[me] - standard_name = mpi_rank - long_name = rank of the current MPI task - units = index - 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 - diff --git a/physics/photochem/module_h2ophys.F90 b/physics/photochem/module_h2ophys.F90 new file mode 100644 index 000000000..c158ba95e --- /dev/null +++ b/physics/photochem/module_h2ophys.F90 @@ -0,0 +1,238 @@ +! ######################################################################################### +!> \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 + real(kind=4) :: blatc4 + + ! 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..a4af0b21c --- /dev/null +++ b/physics/photochem/module_h2ophys.meta @@ -0,0 +1,24 @@ +[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 From cf89e99b968ca5e3cfa088788ea7713f32476c53 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 12 Jun 2024 22:16:40 +0000 Subject: [PATCH 05/11] Bug fix --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 index 08bedf6b5..c92e283e9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -70,4 +70,4 @@ subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_ end subroutine GFS_photochemistry_run -end module GFS_photochemistry_update +end module GFS_photochemistry From afa2bc0632bd1e8a14740da484a431eadc56ec68 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 12 Jun 2024 18:21:54 -0600 Subject: [PATCH 06/11] Use assumed-size arrays in lakeini routine in physics/SFC_Models/Lake/CLM/clm_lake.f90 and remove OPTIONAL keyword from Fortran code to fix intel 19 runtime issues --- physics/SFC_Models/Lake/CLM/clm_lake.f90 | 60 +++++++++++------------- 1 file changed, 28 insertions(+), 32 deletions(-) diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 94ad9d815..565430a08 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -316,7 +316,7 @@ SUBROUTINE clm_lake_run( & REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, lakedepth_default, dtp LOGICAL, INTENT(IN) :: use_lakedepth INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model - REAL(KIND_PHYS), INTENT(INOUT), OPTIONAL :: clm_lake_initialized(:) + REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) LOGICAL, INTENT(IN) :: frac_grid, frac_ice ! @@ -326,7 +326,7 @@ SUBROUTINE clm_lake_run( & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & dlwsfci, dswsfci, oro_lakedepth, wind, & t1, qv1, prsl1 - REAL(KIND_PHYS), DIMENSION(:), INTENT(IN), OPTIONAL :: & + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN) :: & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter @@ -343,34 +343,34 @@ SUBROUTINE clm_lake_run( & weasdi, snodi, hice, qss_water, qss_ice, & cmm_water, cmm_ice, chh_water, chh_ice, & uustar_water, uustar_ice, zorlw, zorli, weasd, snowd, fice - REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) , OPTIONAL :: & + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: & lake_t_snow, albedo, lake_t2m, lake_q2m LOGICAL, INTENT(INOUT) :: icy(:) ! ! Lake model internal state stored by caller: ! - INTEGER, DIMENSION( : ), INTENT(INOUT), OPTIONAL :: salty - INTEGER, DIMENSION( : ), INTENT(INOUT), OPTIONAL :: cannot_freeze + INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty + INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze - real(kind_phys), dimension(: ), OPTIONAL ,intent(inout) :: savedtke12d, & + real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension( :,: ), OPTIONAL, INTENT(inout) :: t_lake3d, & + real(kind_phys), dimension( :,: ), INTENT(inout) :: t_lake3d, & lake_icefrac3d - real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout), OPTIONAL :: t_soisno3d, & + real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & z3d, & dz3d - real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout), OPTIONAL :: zi3d + real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout) :: zi3d - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT), OPTIONAL :: clm_lakedepth - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT), OPTIONAL :: input_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: input_lakedepth ! ! Error reporting: @@ -5377,43 +5377,39 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER , INTENT (IN) :: im, me, master, km, kdt REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, fhour - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT):: FICE, hice - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: TG3, xlat_d, xlon_d - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc - REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized - integer, dimension(IM), intent(in) :: use_lake_model - !INTEGER , INTENT (IN) :: lakeflag - !INTEGER , INTENT (INOUT) :: lake_depth_flag + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT):: FICE, hice + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: TG3, xlat_d, xlon_d + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: tsfc + REAL(KIND_PHYS), DIMENSION(:) ,INTENT(INOUT) :: clm_lake_initialized + integer, dimension(:), intent(in) :: use_lake_model LOGICAL, INTENT (IN) :: use_lakedepth - INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd - REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0 - REAL(kind_phys), DIMENSION(IM,KM+1), INTENT(IN) :: prsi + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: snowd,weasd + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: gt0 + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: prsi real(kind_phys), intent(in) :: lakedepth_default - real(kind_phys), dimension(IM),intent(inout) :: clm_lakedepth - real(kind_phys), dimension(IM),intent(inout) :: input_lakedepth - real(kind_phys), dimension(IM),intent(in) :: oro_lakedepth - real(kind_phys), dimension(IM),intent(out) :: savedtke12d - real(kind_phys), dimension(IM),intent(out) :: snowdp2d, & + real(kind_phys), dimension(:),intent(inout) :: clm_lakedepth + real(kind_phys), dimension(:),intent(inout) :: input_lakedepth + real(kind_phys), dimension(:),intent(in) :: oro_lakedepth + real(kind_phys), dimension(:),intent(out) :: savedtke12d + real(kind_phys), dimension(:),intent(out) :: snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension(IM,nlevlake),INTENT(out) :: t_lake3d, & + real(kind_phys), dimension(:,:),INTENT(out) :: t_lake3d, & lake_icefrac3d - real(kind_phys), dimension(IM,-nlevsnow+1:nlevsoil ),INTENT(out) :: t_soisno3d, & + real(kind_phys), dimension(:,-nlevsnow+1:),INTENT(out) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & z3d, & dz3d - real(kind_phys), dimension( IM,-nlevsnow+0:nlevsoil ),INTENT(out) :: zi3d + real(kind_phys), dimension(:,-nlevsnow+0:),INTENT(out) :: zi3d - !LOGICAL, DIMENSION( : ),intent(out) :: lake - !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP integer :: n,i,j,k,ib,lev,bottom ! indices real(kind_lake),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] From a446feceba9d6301684195791da0b0b2332fcbb7 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 13 Jun 2024 17:45:19 +0000 Subject: [PATCH 07/11] Some bugfixes --- .../UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 5 ++- .../UFS_SCM_NEPTUNE/GFS_photochemistry.meta | 16 +++++----- .../GFS_suite_stateout_update.F90 | 7 ++-- .../GFS_suite_stateout_update.meta | 16 ---------- physics/photochem/module_ozphys.F90 | 32 +++++++++---------- 5 files changed, 30 insertions(+), 46 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 index c92e283e9..c61ddb471 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -14,7 +14,7 @@ module GFS_photochemistry !! ! ######################################################################################### subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, & - prsl, dp, ozpl, h2o_phys, h2ophys, h2opl, h2o0, oz0, do3_dt_prd, do3_dt_ozmx, & + 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 @@ -47,6 +47,9 @@ subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_ real(kind=kind_phys), intent(out), dimension(:,:) :: & oz0, & ! Update ozone concentration. h2o0 ! Updated h2o concentration. + real(kind=kind_phys), intent(inout), dimension(:,:) :: & + gt0 ! Updated temperature + character(len=*), intent(out) :: & errmsg ! CCPP Error message. integer, intent(out) :: & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta index 526910fec..8bce5e7b4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -38,14 +38,6 @@ 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 @@ -108,6 +100,14 @@ type = real kind = kind_phys intent = out +[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 [do3_dt_prd] standard_name = ozone_tendency_due_to_production_and_loss_rate long_name = ozone tendency due to production and loss rate 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 057c50d1e..facdb6213 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -17,8 +17,7 @@ module GFS_suite_stateout_update ! ######################################################################################### subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & - errmsg, errflg) + imp_physics_fer_hires, epsq, errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -26,8 +25,8 @@ 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 + 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 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 4153befb9..2b7572789 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -169,22 +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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/photochem/module_ozphys.F90 b/physics/photochem/module_ozphys.F90 index 898dee921..63c79a58a 100644 --- a/physics/photochem/module_ozphys.F90 +++ b/physics/photochem/module_ozphys.F90 @@ -205,8 +205,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 +221,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 +305,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 +318,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 +334,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,12 +430,11 @@ 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 From 99c02ef5490a4f5367dea92ea51dcbf1fad583a0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 14 Jun 2024 20:19:55 +0000 Subject: [PATCH 08/11] Now B4B Identical --- .../UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 55 +++++++++++++----- .../UFS_SCM_NEPTUNE/GFS_photochemistry.meta | 57 +++++++++++++++++-- physics/photochem/module_h2ophys.F90 | 3 +- 3 files changed, 96 insertions(+), 19 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 index c61ddb471..4a679713e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -8,6 +8,37 @@ module GFS_photochemistry 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? + ! DJS2024 Asks: If everything in _run() is controlled by these logicals, we probably don't + ! need to kill it here, since the run phase will be harmless? + 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 + + end subroutine GFS_photochemistry_init + ! ######################################################################################### !> \section arg_table_GFS_photochemistry_run Argument Table !! \htmlinclude GFS_photochemistry_run.html @@ -18,23 +49,24 @@ subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_ do3_dt_temp, do3_dt_ohoz, errmsg, errflg) ! Inputs - real(kind=kind_phys), intent(in ) :: & + real(kind=kind_phys), intent(in) :: & dtp, & ! Model timestep con_1ovg ! Physical constant (1./gravity) - real(kind=kind_phys), intent(in ), dimension(:,:) :: & + real(kind=kind_phys), intent(in), dimension(:,:) :: & prsl, & ! Air pressure (Pa) - dp ! Pressure thickness (Pa) - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: & - ozpl, & ! Ozone data for current model timestep - h2opl ! h2o data for curent model timestep + 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 h2o photochemistry? + h2o_phys ! Do stratospheric h2o photochemistry? type(ty_ozphys), intent(in) :: & - ozphys ! DDT with ozone photochemistry scheme. + ozphys ! DDT with ozone photochemistry scheme/data. type(ty_h2ophys), intent(in) :: & - h2ophys ! DDT with h2o photochemistry scheme. + h2ophys ! DDT with h2o photochemistry scheme/data. ! Outputs (optional) real(kind=kind_phys), intent(inout), dimension(:,:), optional :: & @@ -44,12 +76,9 @@ subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_ do3_dt_ohoz ! Physics tendency: overhead ozone effect ! Outputs - real(kind=kind_phys), intent(out), dimension(:,:) :: & + real(kind=kind_phys), intent(inout), dimension(:,:) :: & oz0, & ! Update ozone concentration. h2o0 ! Updated h2o concentration. - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - gt0 ! Updated temperature - character(len=*), intent(out) :: & errmsg ! CCPP Error message. integer, intent(out) :: & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta index 8bce5e7b4..4e26241fb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -7,7 +7,48 @@ ######################################################################## [ccpp-arg-table] - name = GFS_photochemistry + 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 @@ -38,6 +79,14 @@ 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 @@ -91,7 +140,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [oz0] standard_name = ozone_concentration_of_new_state long_name = ozone concentration updated by physics @@ -99,7 +148,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gt0] standard_name = air_temperature_of_new_state long_name = temperature updated by physics @@ -107,7 +156,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + 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 diff --git a/physics/photochem/module_h2ophys.F90 b/physics/photochem/module_h2ophys.F90 index c158ba95e..b94539d71 100644 --- a/physics/photochem/module_h2ophys.F90 +++ b/physics/photochem/module_h2ophys.F90 @@ -45,7 +45,6 @@ function load(this, file, fileID) result (err_message) character(len=128) :: err_message integer :: i1, i2, i3, ierr real(kind=4), dimension(:), allocatable :: lat4, pres4, time4, tempin - real(kind=4) :: blatc4 ! initialize error message err_message = "" @@ -231,7 +230,7 @@ subroutine run(this, dt, p, h2opltc, h2o) enddo enddo - + return end subroutine run From de95e37109358a4afc848eb35a25aed8b81bebc3 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Wed, 26 Jun 2024 17:23:09 +0000 Subject: [PATCH 09/11] Output tendency_of_vertically_diffused_tracer_concentration from MYNN PBL --- physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 | 25 +++++++++++++++--- physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta | 29 +++++++++++++++++++++ 2 files changed, 51 insertions(+), 3 deletions(-) diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 index 6dc068758..5c990dc5b 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 @@ -140,7 +140,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc,& ! <=== ntwa, ntia & dqdt_cccn, & ! <=== ntccn - & flag_for_pbl_generic_tend, & + & tmf, flag_for_pbl_generic_tend, & & dtend, dtidx, index_of_temperature, & & index_of_x_wind, index_of_y_wind, ntke, & & ntqv, ntcw, ntiw, ntsw, & @@ -155,7 +155,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & & imp_physics_thompson, imp_physics_wsm6, & - & imp_physics_fa, & + & imp_physics_fa, imfdeepcnv, imfdeepcnv_c3, & + & imfdeepcnv_samf, & & chem3d, frp, mix_chem, rrfs_sd, enh_mix, & & nchem, ndvel, vdep, smoke_dbg, & & imp_physics_nssl, nssl_ccn_on, & @@ -205,7 +206,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_output, & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl, & - & imp_physics_nssl, imp_physics_fa, & + & imp_physics_nssl, imp_physics_fa, imfdeepcnv, & + & imfdeepcnv_c3, imfdeepcnv_samf, & & spp_pbl, & & tke_budget real(kind_phys), intent(in) :: & @@ -252,6 +254,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & EL_PBL, Sh3D, Sm3D, qc_bl, qi_bl, cldfra_bl, dqdt_cccn real(kind_phys), dimension(:,:), intent(inout) :: & & qke_adv + real(kind_phys), dimension(:,:,:), intent(out) :: tmf !These 10 arrays are only allocated when bl_mynn_output > 0 real(kind_phys), dimension(:,:), intent(inout), optional :: & & edmf_a,edmf_w,edmf_qt, & @@ -555,6 +558,13 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo + do k=1,levs + do i=1,im + tmf(i,k,1)=0. + enddo + enddo + + ! Check incoming moist species to ensure non-negative values ! First, create height difference (dz) do k=1,levs @@ -1028,6 +1038,15 @@ SUBROUTINE mynnedmf_wrapper_run( & deallocate(save_qke_adv) endif + if(imfdeepcnv == imfdeepcnv_c3 .or. imfdeepcnv == imfdeepcnv_samf)then + !LB: save PBL q-tendency for use in prognostic closure + do k=1,levs + do i=1,im + tmf(i,k,1)=dqdt_water_vapor(i,k) + enddo + enddo + endif + CONTAINS SUBROUTINE dtend_helper(itracer,field,mult) diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index f2adfc4f5..94f30ad52 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -1150,6 +1150,14 @@ kind = kind_phys intent = inout optional = True +[tmf] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = out [flag_for_pbl_generic_tend] standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer long_name = true if GFS_PBL_generic should calculate tendencies @@ -1428,6 +1436,27 @@ dimensions = () type = integer intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_samf] + standard_name = identifer_for_scale_aware_mass_flux_deep_convection + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in [nssl_ccn_on] standard_name = nssl_ccn_on long_name = CCN activation flag in NSSL micro From 420317e6b8e4adb57c68b1ea9381d1a15f4cc86f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 15 Jul 2024 20:03:52 +0000 Subject: [PATCH 10/11] Address reviewers comments --- .../UFS_SCM_NEPTUNE/GFS_photochemistry.F90 | 11 ++++++++--- .../UFS_SCM_NEPTUNE/GFS_photochemistry.meta | 3 ++- .../GFS_suite_stateout_update.meta | 2 +- physics/MP/Thompson/mp_thompson.F90 | 13 ++++++------- physics/MP/Thompson/mp_thompson.meta | 18 ++++++++++++++++++ physics/photochem/module_h2ophys.meta | 3 ++- 6 files changed, 37 insertions(+), 13 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 index 4a679713e..94c6d1c3b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -29,14 +29,19 @@ subroutine GFS_photochemistry_init(oz_phys_2006, oz_phys_2015, h2o_phys, errmsg, errflg = 0 ! If no photchemical scheme is on, but SDF has this module, report an error? - ! DJS2024 Asks: If everything in _run() is controlled by these logicals, we probably don't - ! need to kill it here, since the run phase will be harmless? 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 ! ######################################################################################### diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta index 4e26241fb..f8874fef7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -207,4 +207,5 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out + \ No newline at end of file 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 2b7572789..8a0d784f2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -3,7 +3,7 @@ name = GFS_suite_stateout_update type = scheme dependencies = ../../hooks/machine.F - + ######################################################################## [ccpp-arg-table] name = GFS_suite_stateout_update_run diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 3b99deec1..ea1320714 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -21,8 +21,6 @@ module mp_thompson private - logical :: is_initialized = .False. - integer, parameter :: ext_ndiag3d = 37 contains @@ -40,7 +38,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & nwfa, nifa, tgrs, prsl, phil, area, & aerfld, mpicomm, mpirank, mpiroot, & threads, ext_diag, diag3d, & - errmsg, errflg) + is_initialized, errmsg, errflg) implicit none @@ -49,6 +47,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & integer, intent(in ) :: nlev real(kind_phys), intent(in ) :: con_g, con_rd, con_eps logical, intent(in ) :: restart + logical, intent(inout) :: is_initialized integer, intent(in ) :: imp_physics integer, intent(in ) :: imp_physics_thompson ! Hydrometeors @@ -338,12 +337,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & - errmsg, errflg) + is_initialized, errmsg, errflg) implicit none ! Interface variables - + logical, intent(inout) :: is_initialized ! Dimensions and constants integer, intent(in ) :: ncol integer, intent(in ) :: nlev @@ -915,10 +914,10 @@ end subroutine mp_thompson_run !> \section arg_table_mp_thompson_finalize Argument Table !! \htmlinclude mp_thompson_finalize.html !! - subroutine mp_thompson_finalize(errmsg, errflg) + subroutine mp_thompson_finalize(is_initialized, errmsg, errflg) implicit none - + logical, intent(inout) :: is_initialized character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index 7d750ee93..26e0c72be 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -282,6 +282,12 @@ kind = kind_phys intent = in optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -782,6 +788,12 @@ kind = kind_phys intent = inout optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -802,6 +814,12 @@ [ccpp-arg-table] name = mp_thompson_finalize type = scheme +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/photochem/module_h2ophys.meta b/physics/photochem/module_h2ophys.meta index a4af0b21c..030050acb 100644 --- a/physics/photochem/module_h2ophys.meta +++ b/physics/photochem/module_h2ophys.meta @@ -21,4 +21,5 @@ long_name = definition of type ty_h2ophys units = DDT dimensions = () - type = ty_h2ophys \ No newline at end of file + type = ty_h2ophys + \ No newline at end of file From cde7c1031eb35f44ec19dc1245cca6b971f1a4ca Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 23 Aug 2024 09:59:02 -0400 Subject: [PATCH 11/11] add missing dimensions attribute for initialized flag --- physics/MP/Thompson/mp_thompson.meta | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index 26e0c72be..320164a4b 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -286,6 +286,7 @@ standard_name = flag_for_thompson_mp_scheme_initialization long_name = flag carrying scheme initialization status units = flag + dimensions = () type = logical intent = inout [errmsg] @@ -792,6 +793,7 @@ standard_name = flag_for_thompson_mp_scheme_initialization long_name = flag carrying scheme initialization status units = flag + dimensions = () type = logical intent = inout [errmsg] @@ -818,6 +820,7 @@ standard_name = flag_for_thompson_mp_scheme_initialization long_name = flag carrying scheme initialization status units = flag + dimensions = () type = logical intent = inout [errmsg]