Line data Source code
1 : module check_energy_fix 2 : use ccpp_kinds, only: kind_phys 3 : 4 : implicit none 5 : private 6 : 7 : public :: check_energy_fix_run 8 : 9 : contains 10 : 11 : ! Add heating rate required for global mean total energy conservation 12 : !> \section arg_table_check_energy_fix_run Argument Table 13 : !! \htmlinclude arg_table_check_energy_fix_run.html 14 24192 : subroutine check_energy_fix_run(ncol, pver, pint, gravit, heat_glob, ptend_s, eshflx, scheme_name, errmsg, errflg) 15 : ! Input arguments 16 : integer, intent(in) :: ncol ! number of atmospheric columns 17 : integer, intent(in) :: pver ! number of vertical layers 18 : real(kind_phys), intent(in) :: pint(:,:) ! interface pressure [Pa] 19 : real(kind_phys), intent(in) :: gravit ! gravitational acceleration [m s-2] 20 : real(kind_phys), intent(in) :: heat_glob ! global mean heating rate [J kg-1 s-1] 21 : real(kind_phys), intent(out) :: ptend_s(:,:) ! physics tendency heating rate [J kg-1 s-1] 22 : real(kind_phys), intent(out) :: eshflx(:) ! effective sensible heat flux [W m-2] 23 : ! for check_energy_chng 24 : 25 : ! Output arguments 26 : character(len=64), intent(out) :: scheme_name ! scheme name 27 : character(len=512), intent(out) :: errmsg ! error message 28 : integer, intent(out) :: errflg ! error flag 29 : 30 : ! Local variables 31 : integer :: i 32 : 33 24192 : errmsg = '' 34 24192 : errflg = 0 35 : 36 : ! Set scheme name for check_energy_chng 37 24192 : scheme_name = "check_energy_fix" 38 : 39 : ! add (-) global mean total energy difference as heating 40 40908672 : ptend_s(:ncol, :pver) = heat_glob 41 : 42 : ! compute effective sensible heat flux 43 314496 : do i = 1, ncol 44 314496 : eshflx(i) = heat_glob * (pint(i,pver+1) - pint(i,1)) / gravit 45 : end do 46 24192 : end subroutine check_energy_fix_run 47 : 48 : end module check_energy_fix