diff --git a/bld/configure b/bld/configure index 6193e62b02..8a7a96dcc0 100755 --- a/bld/configure +++ b/bld/configure @@ -2150,6 +2150,7 @@ sub write_filepath print $fh "$camsrcdir/src/atmos_phys/schemes/cloud_fraction\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/vertical_diffusion\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/holtslag_boville\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/beljaars_drag\n"; # Dynamics package and test utilities print $fh "$camsrcdir/src/dynamics/$dyn\n"; diff --git a/src/physics/cam/beljaars_drag.F90 b/src/physics/cam/beljaars_drag.F90 deleted file mode 100644 index ccafd0e639..0000000000 --- a/src/physics/cam/beljaars_drag.F90 +++ /dev/null @@ -1,152 +0,0 @@ -module beljaars_drag - - implicit none - private - save - - public init_blj ! Initialization - public compute_blj ! Full routine - - ! ------------ ! - ! Private data ! - ! ------------ ! - - integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real - - real(r8), parameter :: horomin= 1._r8 ! Minimum value of subgrid orographic height for mountain stress [ m ] - real(r8), parameter :: z0max = 100._r8 ! Maximum value of z_0 for orography [ m ] - real(r8), parameter :: dv2min = 0.01_r8 ! Minimum shear squared [ m2/s2 ] - real(r8) :: orocnst ! Converts from standard deviation to height [ no unit ] - real(r8) :: z0fac ! Factor determining z_0 from orographic standard deviation [ no unit ] - real(r8) :: karman ! von Karman constant - real(r8) :: gravit ! Acceleration due to gravity - real(r8) :: rair ! Gas constant for dry air - -contains - - !============================================================================ ! - ! ! - !============================================================================ ! - - subroutine init_blj( kind, gravit_in, rair_in , errstring ) - - integer, intent(in) :: kind - real(r8), intent(in) :: gravit_in, rair_in - - character(len=*), intent(out) :: errstring - - errstring = ' ' - - if ( kind /= r8 ) then - errstring = 'inconsistent KIND of reals passed to init_blj' - return - endif - - gravit = gravit_in - rair = rair_in - - end subroutine init_blj - - !============================================================================ ! - ! ! - !============================================================================ ! - - subroutine compute_blj( pcols , pver , ncol , & - u , v , t , pmid , delp , & - zm , sgh , drag , taux , tauy , & - landfrac ) - - !------------------------------------------------------------------------------ ! - ! Beljaars Sub-Grid Orographic (SGO) Form drag parameterization ! - ! ! - ! Returns drag profile and integrated stress associated with subgrid mountains ! - ! with horizontal length scales nominally below 3km. Similar to TMS but ! - ! drag is distributed in the vertical (Beljaars et al., 2003, QJRMS). ! - ! ! - ! First cut follows TMS. J. Bacmeister, March 2016 ! - !------------------------------------------------------------------------------ ! - - ! ---------------------- ! - ! Input-Output Arguments ! - ! ---------------------- ! - - integer, intent(in) :: pcols ! Number of columns dimensioned - integer, intent(in) :: pver ! Number of model layers - integer, intent(in) :: ncol ! Number of columns actually used - - real(r8), intent(in) :: u(pcols,pver) ! Layer mid-point zonal wind [ m/s ] - real(r8), intent(in) :: v(pcols,pver) ! Layer mid-point meridional wind [ m/s ] - real(r8), intent(in) :: t(pcols,pver) ! Layer mid-point temperature [ K ] - real(r8), intent(in) :: pmid(pcols,pver) ! Layer mid-point pressure [ Pa ] - real(r8), intent(in) :: delp(pcols,pver) ! Layer thickness [ Pa ] - real(r8), intent(in) :: zm(pcols,pver) ! Layer mid-point height [ m ] - real(r8), intent(in) :: sgh(pcols) ! Standard deviation of orography [ m ] - real(r8), intent(in) :: landfrac(pcols) ! Land fraction [ fraction ] - - real(r8), intent(out) :: drag(pcols,pver) ! SGO drag profile [ kg/s/m2 ] - real(r8), intent(out) :: taux(pcols) ! Surface zonal wind stress [ N/m2 ] - real(r8), intent(out) :: tauy(pcols) ! Surface meridional wind stress [ N/m2 ] - - ! --------------- ! - ! Local Variables ! - ! --------------- ! - - integer :: i,k ! Loop indices - integer :: kb, kt ! Bottom and top of source region - - real(r8) :: vmag ! Velocity magnitude [ m /s ] - - real(r8) :: alpha,beta,Cmd,Ccorr,n1,n2,k1,kflt,k2,IH - real(r8) :: a1(pcols),a2(pcols) - - alpha = 12._r8 - beta = 1._r8 - n1 = -1.9_r8 - n2 = -2.8_r8 - - Cmd = 0.005_r8 - Ccorr = 0.6_r8 * 5._r8 - - kflt = 0.00035_r8 ! m-1 - k1 = 0.003_r8 ! m-1 - IH = 0.00102_r8 ! m-1 - - a1(1:ncol) = (sgh(1:ncol)*sgh(1:ncol)) / ( IH* (kflt**n1) ) - a2(1:ncol) = a1(1:ncol) * k1**(n1-n2) - - - ! ----------------------- ! - ! Main Computation Begins ! - ! ----------------------- ! - - do k = 1, pver - do i = 1, ncol - Vmag = SQRT( u(i,k)**2 + v(i,k)**2) - drag(i,k) = -alpha * beta * Cmd * Ccorr * Vmag * 2.109_r8 * & - EXP ( -(zm(i,k)/1500._r8 )*SQRT(zm(i,k)/1500._r8) ) * ( zm(i,k)**(-1.2_r8) ) & - * a2(i) - end do - end do - - - !---------------------------------! - ! Diagnose effective surface drag ! - ! in X and Y by integrating in ! - ! the vertical ! - !---------------------------------! - ! FIXME: uses 'state' u and v. - ! Should updated u and v's be used? - - taux=0._r8 - tauy=0._r8 - do k = 1, pver - do i = 1, ncol - taux(i) = taux(i) + drag(i,k)*u(i,k)*delp(i,k)/gravit - tauy(i) = tauy(i) + drag(i,k)*v(i,k)*delp(i,k)/gravit - end do - end do - - return - end subroutine compute_blj - -end module beljaars_drag diff --git a/src/physics/cam/beljaars_drag_cam.F90 b/src/physics/cam/beljaars_drag_cam.F90 index d81d2bb9b0..6010d9d7ee 100644 --- a/src/physics/cam/beljaars_drag_cam.F90 +++ b/src/physics/cam/beljaars_drag_cam.F90 @@ -18,10 +18,6 @@ module beljaars_drag_cam ! Is this module on at all? logical, public, protected :: do_beljaars = .false. -! Tuning parameters for TMS. -real(r8) :: blj_orocnst -real(r8) :: blj_z0fac - ! pbuf field indices integer :: & sgh30_idx = -1, & @@ -34,7 +30,7 @@ module beljaars_drag_cam subroutine beljaars_drag_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit - use spmd_utils, only: masterprocid, mpi_logical, mpi_real8, mpicom + use spmd_utils, only: masterprocid, mpi_logical, mpicom ! filepath for file containing namelist input character(len=*), intent(in) :: nlfile @@ -79,23 +75,15 @@ end subroutine beljaars_drag_register subroutine beljaars_drag_init() use cam_history, only: addfld, add_default, horiz_only - use error_messages, only: handle_errmsg use phys_control, only: phys_getopts - use physconst, only: karman, gravit, rair use physics_buffer, only: pbuf_get_index - use beljaars_drag, only: init_blj logical :: history_amwg - character(len=128) :: errstring - if (.not. do_beljaars) return call phys_getopts(history_amwg_out=history_amwg) - call init_blj( r8, gravit, rair, errstring ) - call handle_errmsg(errstring, subname="init_blj") - call addfld('DRAGBLJ', (/ 'lev' /) , 'A', '1/s', 'Drag profile from Beljaars SGO ') call addfld('TAUBLJX', horiz_only, 'A', 'N/m2', 'Zonal integrated drag from Beljaars SGO') call addfld('TAUBLJY', horiz_only, 'A', 'N/m2', 'Meridional integrated drag from Beljaars SGO') @@ -112,21 +100,27 @@ subroutine beljaars_drag_init() end subroutine beljaars_drag_init -subroutine beljaars_drag_tend(state, pbuf, cam_in) +subroutine beljaars_drag_tend(state, pbuf) use physics_buffer, only: physics_buffer_desc, pbuf_get_field use physics_types, only: physics_state - use camsrfexch, only: cam_in_t use cam_history, only: outfld - use beljaars_drag, only: compute_blj + + use physconst, only: gravit + use beljaars_drag, only: beljaars_drag_run type(physics_state), intent(in) :: state type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) - type(cam_in_t), intent(in) :: cam_in real(r8), pointer :: sgh30(:) real(r8), pointer :: dragblj(:,:) real(r8), pointer :: taubljx(:), taubljy(:) + integer :: ncol + character(len=512) :: errmsg + integer :: errflg + + ncol = state%ncol + call pbuf_get_field(pbuf, dragblj_idx, dragblj) call pbuf_get_field(pbuf, taubljx_idx, taubljx) call pbuf_get_field(pbuf, taubljy_idx, taubljy) @@ -140,10 +134,31 @@ subroutine beljaars_drag_tend(state, pbuf, cam_in) call pbuf_get_field(pbuf, sgh30_idx, sgh30) - call compute_blj( pcols , pver , state%ncol , & - state%u , state%v , state%t , state%pmid , & - state%pdel , state%zm , sgh30 , dragblj , & - taubljx , taubljy , cam_in%landfrac ) + ! zero to pcols + dragblj(:, :) = 0._r8 + taubljx(:) = 0._r8 + taubljy(:) = 0._r8 + + ! Call the CCPPized subroutine: + call beljaars_drag_run( & + do_beljaars = do_beljaars, & + ncol = state%ncol, & + pver = pver, & + u = state%u(:ncol, :), & + v = state%v(:ncol, :), & + delp = state%pdel(:ncol, :), & + zm = state%zm(:ncol, :), & + sgh30 = sgh30(:ncol), & + gravit = gravit, & + drag = dragblj(:ncol, :), & + taux = taubljx(:ncol), & + tauy = taubljy(:ncol), & + errmsg = errmsg, & + errflg = errflg) + + if(errflg /= 0) then + call endrun('beljaars_drag_run: '//errmsg) + end if call outfld("TAUBLJX", taubljx, pcols, state%lchnk) call outfld("TAUBLJY", taubljy, pcols, state%lchnk) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 27790526e5..b4cc220f2e 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1689,7 +1689,7 @@ subroutine tphysac (ztodt, cam_in, & end if call trb_mtn_stress_tend(state, pbuf, cam_in) - call beljaars_drag_tend(state, pbuf, cam_in) + call beljaars_drag_tend(state, pbuf) if (trim(cam_take_snapshot_after) == "orographic_form_drag_stress") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index ae1620787a..a623c4c085 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -2204,7 +2204,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call beljaars_drag_tend(state, pbuf, cam_in) + call beljaars_drag_tend(state, pbuf) ! TMS is not active in CAM7 (it is only for CAM5), but the tms tend subroutine ! will initialize the pbuf fields to zero - no logic is computed below: