From ddbd127f79a3aa9c191220ac98f78a416e2c6cec Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 12 Jun 2024 22:12:12 +0000 Subject: [PATCH 1/6] 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 2/6] 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 a446feceba9d6301684195791da0b0b2332fcbb7 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 13 Jun 2024 17:45:19 +0000 Subject: [PATCH 3/6] 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 4/6] 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 420317e6b8e4adb57c68b1ea9381d1a15f4cc86f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 15 Jul 2024 20:03:52 +0000 Subject: [PATCH 5/6] 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 2e3bf1f5672501c13b143ed1b23120bd10537305 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 23 Aug 2024 15:51:32 +0000 Subject: [PATCH 6/6] Omission from previous commit --- 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]