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