LCOV - code coverage report
Current view: | top level - physics/cam - trb_mtn_stress_cam.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 40 | 58 | 69.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 4 | 4 | 100.0 %

              Line data    Source code
           1             : module trb_mtn_stress_cam
           2             :
           3             : use shr_kind_mod, only: r8 => shr_kind_r8
           4             : use spmd_utils, only: masterproc
           5             : use cam_abortutils, only: endrun
           6             : use shr_log_mod, only: errMsg => shr_log_errMsg
           7             : use cam_logfile, only: iulog
           8             : use ppgrid, only: pcols, pver
           9             :
          10             : implicit none
          11             : private
          12             :
          13             : public :: trb_mtn_stress_readnl
          14             : public :: trb_mtn_stress_register
          15             : public :: trb_mtn_stress_init
          16             : public :: trb_mtn_stress_tend
          17             :
          18             : ! Is this module on at all?
          19             : logical :: do_tms = .false.
          20             :
          21             : ! Tuning parameters for TMS.
          22             : real(r8) :: tms_orocnst
          23             : real(r8) :: tms_z0fac
          24             :
          25             : ! pbuf field indices
          26             : integer :: &
          27             :      sgh30_idx = -1, &
          28             :      ksrftms_idx = -1, &
          29             :      tautmsx_idx = -1, &
          30             :      tautmsy_idx = -1
          31             :
          32             : contains
          33             :
          34     1490712 : subroutine trb_mtn_stress_readnl(nlfile)
          35             :   use namelist_utils, only: find_group_name
          36             :   use units, only: getunit, freeunit
          37             :   use spmd_utils, only: masterprocid, mpi_logical, mpi_real8, mpicom
          38             :
          39             :   ! filepath for file containing namelist input
          40             :   character(len=*), intent(in) :: nlfile
          41             :
          42             :   ! file unit and error code
          43             :   integer :: unitn, ierr
          44             :
          45             :   character(len=*), parameter :: subname = "trb_mtn_stress_readnl"
          46             :
          47             :   namelist /tms_nl/ do_tms, tms_orocnst, tms_z0fac
          48             :
          49        1536 :   ierr = 0
          50             :
          51        1536 :   if (masterproc) then
          52           2 :      unitn = getunit()
          53           2 :      open( unitn, file=trim(nlfile), status='old' )
          54           2 :      call find_group_name(unitn, 'tms_nl', status=ierr)
          55           2 :      if (ierr == 0) then
          56           2 :         read(unitn, tms_nl, iostat=ierr)
          57           2 :         if (ierr /= 0) then
          58           0 :            call endrun(subname // ':: ERROR reading namelist')
          59             :         end if
          60             :      end if
          61           2 :      close(unitn)
          62           2 :      call freeunit(unitn)
          63             :   end if
          64             :
          65        1536 :   call mpi_bcast(do_tms,      1, mpi_logical, masterprocid, mpicom, ierr)
          66        1536 :   if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
          67        1536 :   call mpi_bcast(tms_orocnst, 1,   mpi_real8, masterprocid, mpicom, ierr)
          68        1536 :   if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
          69        1536 :   call mpi_bcast(tms_z0fac,   1,   mpi_real8, masterprocid, mpicom, ierr)
          70        1536 :   if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
          71             :
          72        1536 : end subroutine trb_mtn_stress_readnl
          73             :
          74        1536 : subroutine trb_mtn_stress_register()
          75             :   use physics_buffer, only: pbuf_add_field, dtype_r8
          76             :
          77        1536 :   call pbuf_add_field("ksrftms", "physpkg", dtype_r8, [pcols], ksrftms_idx)
          78        1536 :   call pbuf_add_field("tautmsx", "physpkg", dtype_r8, [pcols], tautmsx_idx)
          79        1536 :   call pbuf_add_field("tautmsy", "physpkg", dtype_r8, [pcols], tautmsy_idx)
          80             :
          81        1536 : end subroutine trb_mtn_stress_register
          82             :
          83        1536 : subroutine trb_mtn_stress_init()
          84             :
          85        1536 :   use cam_history, only: addfld, add_default, horiz_only
          86             :   use error_messages, only: handle_errmsg
          87             :   use phys_control, only: phys_getopts
          88             :   use physconst, only: karman, gravit, rair
          89             :   use physics_buffer, only: pbuf_get_index
          90             :   use trb_mtn_stress, only: init_tms
          91             :
          92             :   logical :: history_amwg
          93             :
          94             :   character(len=128) :: errstring
          95             :
          96        1536 :   if (.not. do_tms) return
          97             :
          98           0 :   call phys_getopts(history_amwg_out=history_amwg)
          99             :
         100           0 :   call init_tms( r8, tms_orocnst, tms_z0fac, karman, gravit, rair, errstring)
         101           0 :   call handle_errmsg(errstring, subname="init_tms")
         102             :
         103           0 :   call addfld('TAUTMSX', horiz_only, 'A', 'N/m2', 'Zonal      turbulent mountain surface stress')
         104           0 :   call addfld('TAUTMSY', horiz_only, 'A', 'N/m2', 'Meridional turbulent mountain surface stress')
         105           0 :   if (history_amwg) then
         106           0 :      call add_default( 'TAUTMSX ', 1, ' ' )
         107           0 :      call add_default( 'TAUTMSY ', 1, ' ' )
         108             :   end if
         109             :
         110           0 :   if (masterproc) then
         111           0 :      write(iulog,*)'Using turbulent mountain stress module'
         112           0 :      write(iulog,*)'  tms_orocnst = ',tms_orocnst
         113           0 :      write(iulog,*)'  tms_z0fac = ',tms_z0fac
         114             :   end if
         115             :
         116           0 :   sgh30_idx = pbuf_get_index("SGH30")
         117             :
         118        1536 : end subroutine trb_mtn_stress_init
         119             :
         120     1489176 : subroutine trb_mtn_stress_tend(state, pbuf, cam_in)
         121        1536 :   use physics_buffer, only: physics_buffer_desc, pbuf_get_field
         122             :   use physics_types, only: physics_state
         123             :   use camsrfexch, only: cam_in_t
         124             :   use cam_history, only: outfld
         125             :   use trb_mtn_stress, only: compute_tms
         126             :
         127             :   type(physics_state), intent(in) :: state
         128             :   type(physics_buffer_desc), pointer, intent(in) :: pbuf(:)
         129             :   type(cam_in_t), intent(in) :: cam_in
         130             :
         131     1489176 :   real(r8), pointer :: sgh30(:)
         132     1489176 :   real(r8), pointer :: ksrftms(:)
         133     1489176 :   real(r8), pointer :: tautmsx(:), tautmsy(:)
         134             :
         135     1489176 :   call pbuf_get_field(pbuf, ksrftms_idx, ksrftms)
         136     1489176 :   call pbuf_get_field(pbuf, tautmsx_idx, tautmsx)
         137     1489176 :   call pbuf_get_field(pbuf, tautmsy_idx, tautmsy)
         138             :
         139     1489176 :   if (.not. do_tms) then
         140    25315992 :      ksrftms = 0._r8
         141    25315992 :      tautmsx = 0._r8
         142    25315992 :      tautmsy = 0._r8
         143             :      return
         144             :   end if
         145             :
         146           0 :   call pbuf_get_field(pbuf, sgh30_idx, sgh30)
         147             :
         148             :   call compute_tms( pcols    , pver    , state%ncol , &
         149             :        state%u    , state%v  , state%t , state%pmid , &
         150             :        state%exner, state%zm , sgh30   , ksrftms    , &
         151           0 :        tautmsx    , tautmsy  , cam_in%landfrac )
         152             :
         153           0 :   call outfld("TAUTMSX", tautmsx, pcols, state%lchnk)
         154           0 :   call outfld("TAUTMSY", tautmsy, pcols, state%lchnk)
         155             :
         156     2978352 : end subroutine trb_mtn_stress_tend
         157             :
         158             : end module trb_mtn_stress_cam

Generated by: LCOV version 1.14