diff --git a/.gitmodules b/.gitmodules index bba0f7e340..943545a0bf 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/ESCOMP/atmospheric_physics - fxtag = atmos_phys0_12_000 + fxtag = atmos_phys0_13_000 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/bld/build-namelist b/bld/build-namelist index 9c3427b0f8..36392a8113 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -5262,6 +5262,7 @@ sub check_snapshot_settings { "'qbo_relax'", "'iondrag_calc_section'", "'physics_dme_adjust'")); push (@validList_bc, ("'dadadj_tend'", "'convect_deep_tend'", + "'rayleigh_friction_tend'", "'convect_diagnostics_calc'")); } else { # CAM physpkg @@ -5276,6 +5277,7 @@ sub check_snapshot_settings { "'qbo_relax'", "'iondrag_calc_section'", "'physics_dme_adjust'")); push (@validList_bc, ("'dadadj_tend'", "'convect_deep_tend'", + "'rayleigh_friction_tend'", "'convect_shallow_tend'")); if ($microphys =~ /^mg/) { if ($clubb_sgs =~ /$TRUE/io) { diff --git a/bld/configure b/bld/configure index 6c12d4718f..382dd019e4 100755 --- a/bld/configure +++ b/bld/configure @@ -2177,6 +2177,7 @@ sub write_filepath print $fh "$camsrcdir/src/atmos_phys/schemes/hack_shallow\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/rasch_kristjansson\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/utilities\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rayleigh_friction\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/cloud_fraction\n"; diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 72d5a66a06..a2946cd243 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5665,7 +5665,7 @@ Default: + group="phys_ctl_nl" valid_values="chem_emissions,aoa_tracers_timestep_tend,co2_cycle_set_ptend,chem_timestep_tend,vertical_diffusion_section,aero_model_drydep,gw_tend,qbo_relax,iondrag_calc_section,physics_dme_adjust,physics_dme_adjust,dadadj_tend,convect_deep_tend,convect_shallow_tend,convect_diagnostics_calc,macrop_driver_tend,clubb_tend_cam,microp_section,microp_driver_tend_subcol,aero_model_wetdep,radiation_tend,held_suarez_tend,kessler_tend,thatcher_jablonowski_precip_tend,rk_stratiform_tend,rayleigh_friction_tend,user_set" > Name of parameterization to take snapshot before running user_set is used when a user inserts a call to cam_snapshot_all_outfld using cam_snapshot_before_num as the first argument. @@ -5673,7 +5673,7 @@ Default: Unused + group="phys_ctl_nl" valid_values="chem_emissions,aoa_tracers_timestep_tend,co2_cycle_set_ptend,chem_timestep_tend,vertical_diffusion_section,aero_model_drydep,gw_tend,qbo_relax,iondrag_calc_section,physics_dme_adjust,physics_dme_adjust,dadadj_tend,convect_deep_tend,convect_shallow_tend,convect_diagnostics_calc,macrop_driver_tend,clubb_tend_cam,microp_section,microp_driver_tend_subcol,aero_model_wetdep,radiation_tend,held_suarez_tend,kessler_tend,thatcher_jablonowski_precip_tend,rk_stratiform_tend,rayleigh_friction_tend,user_set" > Name of parameterization to take snapshot after running user_set is used when a user inserts a call to cam_snapshot_all_outfld using cam_snapshot_after_num as the first argument. diff --git a/doc/ChangeLog b/doc/ChangeLog index 22ff9329cb..37bbf6b98c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,88 @@ =============================================================== +Tag name: cam6_4_086 +Originator(s): katetc +Date: 18 April 2025 +One-line Summary: CCPP-ize Rayleigh Friction +Github PR URL: https://github.com/ESCOMP/CAM/pull/1245 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Brings in new atmospheric_physics external and changes Rayleigh Friction code to use CCPP compatible interfaces +- Closes #1153 - Conversion of Rayleigh Friction to CCPP + +Describe any changes made to build system: + bld/configure + - Add src/atmos_phys/schemes/rayleigh_friction to the build tree + +Describe any changes made to the namelist: + bld/build-namelist + bld/namelist_files/namelist_definition.xml + - Changes to add rayleigh_friction_tend snapshot capability + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, cacraig + +List all files eliminated: +D src/physics/cam/rayleigh_friction.F90 + - moved to atmospheric_physics: rayleigh_friction scheme + +List all files added and what they do: +A src/physics/cam/rayleigh_friction_cam.F90 + - Contains the read_nl code and namelist parameters for ccppized Rayleigh Friction scheme + +List all existing files that have been modified, and describe the changes: +M .gitmodules +M src/atmos_phys + - New atmospheric_physics external tag atmos_phys0_13_000 and updated submodule + +M bld/build-namelist +M bld/namelist_files/namelist_definition.xml + - Add snapshot cpability for rayleigh_friction_tend + +M bld/configure + - Add src/atmos_phys/schemes/rayleigh_friction to the build tree + +M src/control/runtime_opts.F90 + - Change module for rayleigh_friction_readnl from rayleigh_friction to rayleigh_friction_cam + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - Non-Answer changing modifications to use the CCPP version of Rayleigh Friction + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures due to HEMCO not having reproducible results (issues #1018 and #856) + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: PASS) details: + - Compare against cam6_4_082_nvhpc baselines due to machine error preventing the test from running for the last few tags. + +izumi/nag/aux_cam: + - All pass + +izumi/gnu/aux_cam: + - All pass + +CAM tag used for the baseline comparison tests if different than previous +tag: Nvhpc baseline comapare against cam6_4_082_nvhpc due to machine problems between tags + +Summarize any changes to answers: + No answer changes, all b4b + +=============================================================== + Tag name: cam6_4_085 Originator(s): jimmielin Date: 11 April 2025 diff --git a/src/atmos_phys b/src/atmos_phys index 315ef4d974..4589f434a3 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 315ef4d974c79f3f4c25131d891d7984fdc454ab +Subproject commit 4589f434a31e031e665d0d73b379ffb72cd81659 diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 0422dc6d57..cb1a95c8e7 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -77,7 +77,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use aircraft_emit, only: aircraft_emit_readnl use cospsimulator_intr, only: cospsimulator_intr_readnl use vertical_diffusion, only: vd_readnl - use rayleigh_friction, only: rayleigh_friction_readnl + use rayleigh_friction_cam, only: rayleigh_friction_readnl use cam_diagnostics, only: diag_readnl use radheat, only: radheat_readnl diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 83f8d7f724..f171b11b17 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -743,6 +743,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use tracers, only: tracers_init use aoa_tracers, only: aoa_tracers_init use rayleigh_friction, only: rayleigh_friction_init + use rayleigh_friction_cam, only: rf_nl_k0, rf_nl_krange, rf_nl_tau0 use vertical_diffusion, only: vertical_diffusion_init use phys_debug_util, only: phys_debug_init use rad_constituents, only: rad_cnst_init @@ -791,6 +792,11 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields + + ! Needed for rayleigh friction + character(len=512) errmsg + integer errflg + !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) @@ -879,7 +885,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call gw_init() - call rayleigh_friction_init() + call rayleigh_friction_init(pver, rf_nl_tau0, rf_nl_krange, rf_nl_k0, masterproc, & + iulog, errmsg, errflg) + if (errflg /= 0) call endrun(errmsg) call vertical_diffusion_init(pbuf2d) @@ -1360,11 +1368,11 @@ subroutine tphysac (ztodt, cam_in, & use cam_diagnostics, only: diag_phys_tend_writeout use gw_drag, only: gw_tend use vertical_diffusion, only: vertical_diffusion_tend - use rayleigh_friction, only: rayleigh_friction_tend + use rayleigh_friction, only: rayleigh_friction_run use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & physics_dme_adjust, set_dry_to_wet, physics_state_check, & - dyn_te_idx + dyn_te_idx, physics_ptend_init use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend @@ -1456,6 +1464,10 @@ subroutine tphysac (ztodt, cam_in, & ! For aerosol budget diagnostics type(carma_diags_t), pointer :: carma_diags_obj + ! For rayleigh friction CCPP calls + character(len=512) errmsg + integer errflg + !----------------------------------------------------------------------- carma_diags_obj => carma_diags_t() if (.not.associated(carma_diags_obj)) then @@ -1676,7 +1688,28 @@ subroutine tphysac (ztodt, cam_in, & ! Rayleigh friction calculation !=================================================== call t_startf('rayleigh_friction') - call rayleigh_friction_tend( ztodt, state, ptend) + if (trim(cam_take_snapshot_before) == "rayleigh_friction_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) + end if + + call physics_ptend_init(ptend, state%psetcols, 'rayleigh friction', ls=.true., lu=.true., lv=.true.) + + ! Initialize ptend variables to zero + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend%u(:,:) = 0._r8 + ptend%v(:,:) = 0._r8 + ptend%s(:,:) = 0._r8 + !REMOVECAM_END + + call rayleigh_friction_run(pver, ztodt, state%u(:ncol,:), state%v(:ncol,:), ptend%u(:ncol,:),& + ptend%v(:ncol,:), ptend%s(:ncol,:), errmsg, errflg) + if (errflg /= 0) call endrun(errmsg) + + if ( (trim(cam_take_snapshot_after) == "rayleigh_friction_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if if ( ptend%lu ) then call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) end if @@ -1684,6 +1717,10 @@ subroutine tphysac (ztodt, cam_in, & call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) end if call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "rayleigh_friction_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) + end if call t_stopf('rayleigh_friction') if (do_clubb_sgs) then diff --git a/src/physics/cam/rayleigh_friction.F90 b/src/physics/cam/rayleigh_friction.F90 deleted file mode 100644 index 8d70000fce..0000000000 --- a/src/physics/cam/rayleigh_friction.F90 +++ /dev/null @@ -1,191 +0,0 @@ - -module rayleigh_friction - -!--------------------------------------------------------------------------------- -! Module to apply rayleigh friction in region of model top. -! We specify a decay rate profile that is largest at the model top and -! drops off vertically using a hyperbolic tangent profile. -! We compute the tendencies in u and v using an Euler backward scheme. -! We then apply the negative of the kinetic energy tendency to "s", the dry -! static energy. -! -! calling sequence: -! -! rayleigh_friction_init initializes rayleigh friction constants -! rayleigh_friction_tend computes rayleigh friction tendencies -! -!---------------------------Code history-------------------------------- -! This is a new routine written by Art Mirin in collaboration with Phil Rasch. -! Initial coding for this version: Art Mirin, May 2007. -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pver -use spmd_utils, only: masterproc -use phys_control, only: use_simple_phys -use cam_logfile, only: iulog -use cam_abortutils, only: endrun - -implicit none -private -save - -! Public interfaces -public :: & - rayleigh_friction_readnl, &! read namelist - rayleigh_friction_init, &! Initialization - rayleigh_friction_tend ! Computation of tendencies - -! Namelist variables -integer :: rayk0 = 2 ! vertical level at which rayleigh friction term is centered -real(r8) :: raykrange = 0._r8 ! range of rayleigh friction profile - ! if 0, range is set to satisfy x=2 (see below) -real(r8) :: raytau0 = 0._r8 ! approximate value of decay time at model top (days) - ! if 0., no rayleigh friction is applied -! Local -real (r8) :: krange ! range of rayleigh friction profile -real (r8) :: tau0 ! approximate value of decay time at model top -real (r8) :: otau0 ! inverse of tau0 -real (r8) :: otau(pver) ! inverse decay time versus vertical level - -! We apply a profile of the form otau0 * [1 + tanh (x)] / 2 , where -! x = (k0 - k) / krange. The default is for x to equal 2 at k=1, meaning -! krange = (k0 - 1) / 2. The default is applied when raykrange is set to 0. -! If otau0 = 0, no term is applied. - -!=============================================================================== -contains -!=============================================================================== - -subroutine rayleigh_friction_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8 - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: sub = 'rayleigh_friction_readnl' - - namelist /rayleigh_friction_nl/ rayk0, raykrange, raytau0 - !----------------------------------------------------------------------------- - - if (use_simple_phys) return - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'rayleigh_friction_nl', status=ierr) - if (ierr == 0) then - read(unitn, rayleigh_friction_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(sub//': FATAL: reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - call mpi_bcast(rayk0, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rayk0") - call mpi_bcast(raykrange, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raykrange") - call mpi_bcast(raytau0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raytau0") - - if (masterproc) then - if (raytau0 > 0._r8) then - write (iulog,*) 'Rayleigh friction options: ' - write (iulog,*) ' rayk0 = ', rayk0 - write (iulog,*) ' raykrange = ', raykrange - write (iulog,*) ' raytau0 = ', raytau0 - else - write (iulog,*) 'Rayleigh friction not enabled.' - end if - end if - -end subroutine rayleigh_friction_readnl - -!=============================================================================== - -subroutine rayleigh_friction_init() - - !---------------------------Local storage------------------------------- - real (r8) x - integer k - - !----------------------------------------------------------------------- - ! Compute tau array - !----------------------------------------------------------------------- - - krange = raykrange - if (raykrange .eq. 0._r8) krange = (rayk0 - 1) / 2._r8 - - tau0 = (86400._r8) * raytau0 ! convert to seconds - otau0 = 0._r8 - if (tau0 .ne. 0._r8) otau0 = 1._r8/tau0 - - do k = 1, pver - x = (rayk0 - k) / krange - otau(k) = otau0 * (1 + tanh(x)) / (2._r8) - enddo - - if (masterproc) then - if (tau0 > 0._r8) then - write (iulog,*) 'Rayleigh friction - krange = ', krange - write (iulog,*) 'Rayleigh friction - otau0 = ', otau0 - write (iulog,*) 'Rayleigh friction decay rate profile' - do k = 1, pver - write (iulog,*) ' k = ', k, ' otau = ', otau(k) - enddo - end if - end if - -end subroutine rayleigh_friction_init - -!========================================================================================= - -subroutine rayleigh_friction_tend( & - ztodt ,state ,ptend ) - - !----------------------------------------------------------------------- - ! compute tendencies for rayleigh friction - !----------------------------------------------------------------------- - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - - !------------------------------Arguments-------------------------------- - real(r8), intent(in) :: ztodt ! physics timestep - type(physics_state), intent(in) :: state ! physics state variables - - type(physics_ptend), intent(out):: ptend ! individual parameterization tendencies - - !---------------------------Local storage------------------------------- - integer :: ncol ! number of atmospheric columns - integer :: k ! level - real(r8) :: rztodt ! 1./ztodt - real(r8) :: c1, c2, c3 ! temporary variables - !----------------------------------------------------------------------- - - call physics_ptend_init(ptend, state%psetcols, 'rayleigh friction', ls=.true., lu=.true., lv=.true.) - - if (otau0 .eq. 0._r8) return - - rztodt = 1._r8/ztodt - ncol = state%ncol - - ! u, v and s are modified by rayleigh friction - - do k = 1, pver - c2 = 1._r8 / (1._r8 + otau(k)*ztodt) - c1 = -otau(k) * c2 - c3 = 0.5_r8 * (1._r8 - c2*c2) * rztodt - ptend%u(:ncol,k) = c1 * state%u(:ncol,k) - ptend%v(:ncol,k) = c1 * state%v(:ncol,k) - ptend%s(:ncol,k) = c3 * (state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - enddo - -end subroutine rayleigh_friction_tend - -end module rayleigh_friction diff --git a/src/physics/cam/rayleigh_friction_cam.F90 b/src/physics/cam/rayleigh_friction_cam.F90 new file mode 100644 index 0000000000..1d7ce50c50 --- /dev/null +++ b/src/physics/cam/rayleigh_friction_cam.F90 @@ -0,0 +1,98 @@ +module rayleigh_friction_cam + +!--------------------------------------------------------------------------------- +! This contains the residual code required to read namelists for the +! Rayliegh Friction scheme. All of the functional code (the init and run subroutines) +! has been moved to ncar_ccpp code. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pver +use spmd_utils, only: masterproc +use phys_control, only: use_simple_phys +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +! Public interfaces +public :: rayleigh_friction_readnl ! read namelist +! Rayleigh friction namelist parameters for use in physpkg +integer, public :: rf_nl_k0 = 2 ! vertical level at which rayleigh friction term is centered +real(r8), public :: rf_nl_krange = 0._r8 ! range of rayleigh friction profile + ! if 0, range is set to satisfy x=2 (see below) +real(r8), public :: rf_nl_tau0 = 0._r8 ! approximate value of decay time at model top (days) + ! if 0., no rayleigh friction is applied + +!=============================================================================== +contains +!=============================================================================== + +subroutine rayleigh_friction_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, rayk0 + real (r8) :: raykrange, raytau0 + character(len=*), parameter :: sub = 'rayleigh_friction_readnl' + + namelist /rayleigh_friction_nl/ rayk0, raykrange, raytau0 + !----------------------------------------------------------------------------- + + if (use_simple_phys) return + + ! Initialize with default values + rayk0 = rf_nl_k0 + raykrange = rf_nl_krange + raytau0 = rf_nl_tau0 + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'rayleigh_friction_nl', status=ierr) + if (ierr == 0) then + read(unitn, rayleigh_friction_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + call mpi_bcast(rayk0, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rayk0") + call mpi_bcast(raykrange, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raykrange") + call mpi_bcast(raytau0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: raytau0") + + ! Set module variables + rf_nl_tau0 = raytau0 + rf_nl_krange = raykrange + rf_nl_k0 = rayk0 + + if (masterproc) then + if (raytau0 > 0._r8) then + write (iulog,*) 'Rayleigh friction options: ' + write (iulog,*) ' rayk0 = ', rf_nl_k0 + write (iulog,*) ' raykrange = ', rf_nl_krange + write (iulog,*) ' raytau0 = ', rf_nl_tau0 + else + write (iulog,*) 'Rayleigh friction not enabled.' + end if + end if + +end subroutine rayleigh_friction_readnl + +!========================================================================================= + +end module rayleigh_friction_cam diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index c585160963..48528361e0 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -739,6 +739,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use tracers, only: tracers_init use aoa_tracers, only: aoa_tracers_init use rayleigh_friction, only: rayleigh_friction_init + use rayleigh_friction_cam, only: rf_nl_k0, rf_nl_krange, rf_nl_tau0 use vertical_diffusion, only: vertical_diffusion_init use phys_debug_util, only: phys_debug_init use phys_debug, only: phys_debug_state_init @@ -788,6 +789,10 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields + ! Needed for rayleigh friction + character(len=512) errmsg + integer errflg + !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) @@ -876,7 +881,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call gw_init() - call rayleigh_friction_init() + call rayleigh_friction_init(pver, rf_nl_tau0, rf_nl_krange, rf_nl_k0, masterproc, & + iulog, errmsg, errflg) + if (errflg /= 0) call endrun(errmsg) call vertical_diffusion_init(pbuf2d) @@ -1357,7 +1364,7 @@ subroutine tphysac (ztodt, cam_in, & use cam_diagnostics, only: diag_phys_tend_writeout use gw_drag, only: gw_tend use vertical_diffusion, only: vertical_diffusion_tend - use rayleigh_friction, only: rayleigh_friction_tend + use rayleigh_friction, only: rayleigh_friction_run use physics_types, only: physics_dme_adjust, set_dry_to_wet, physics_state_check, & dyn_te_idx use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion @@ -1519,6 +1526,10 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction + ! For rayleigh friction CCPP calls + character(len=512) errmsg + integer errflg + !----------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol @@ -2163,7 +2174,28 @@ subroutine tphysac (ztodt, cam_in, & ! Rayleigh friction calculation !=================================================== call t_startf('rayleigh_friction') - call rayleigh_friction_tend( ztodt, state, ptend) + if (trim(cam_take_snapshot_before) == "rayleigh_friction_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call physics_ptend_init(ptend, state%psetcols, 'rayleigh friction', ls=.true., lu=.true., lv=.true.) + + ! Initialize ptend variables to zero + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend%u(:,:) = 0._r8 + ptend%v(:,:) = 0._r8 + ptend%s(:,:) = 0._r8 + !REMOVECAM_END + + call rayleigh_friction_run(pver, ztodt, state%u(:ncol,:), state%v(:ncol,:), ptend%u(:ncol,:),& + ptend%v(:ncol,:), ptend%s(:ncol,:), errmsg, errflg) + if (errflg /= 0) call endrun(errmsg) + + if ( (trim(cam_take_snapshot_after) == "rayleigh_friction_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if if ( ptend%lu ) then call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) end if @@ -2171,6 +2203,10 @@ subroutine tphysac (ztodt, cam_in, & call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) end if call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "rayleigh_friction_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if call t_stopf('rayleigh_friction') if (do_clubb_sgs) then