LCOV - code coverage report
Current view: | top level - physics/cam - beljaars_drag.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 32 | 34 | 94.1 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 2 | 2 | 100.0 %

              Line data    Source code
           1             : module beljaars_drag
           2             :
           3             :   implicit none
           4             :   private
           5             :   save
           6             :
           7             :   public init_blj                             ! Initialization
           8             :   public compute_blj                          ! Full routine
           9             :
          10             :   ! ------------ !
          11             :   ! Private data !
          12             :   ! ------------ !
          13             :
          14             :   integer,  parameter :: r8 = selected_real_kind(12) ! 8 byte real
          15             :
          16             :   real(r8), parameter :: horomin= 1._r8       ! Minimum value of subgrid orographic height for mountain stress [ m ]
          17             :   real(r8), parameter :: z0max  = 100._r8     ! Maximum value of z_0 for orography [ m ]
          18             :   real(r8), parameter :: dv2min = 0.01_r8     ! Minimum shear squared [ m2/s2 ]
          19             :   real(r8)            :: orocnst              ! Converts from standard deviation to height [ no unit ]
          20             :   real(r8)            :: z0fac                ! Factor determining z_0 from orographic standard deviation [ no unit ]
          21             :   real(r8)            :: karman               ! von Karman constant
          22             :   real(r8)            :: gravit               ! Acceleration due to gravity
          23             :   real(r8)            :: rair                 ! Gas constant for dry air
          24             :
          25             : contains
          26             :
          27             :   !============================================================================ !
          28             :   !                                                                             !
          29             :   !============================================================================ !
          30             :
          31        1536 :   subroutine init_blj( kind, gravit_in, rair_in , errstring )
          32             :
          33             :     integer,  intent(in) :: kind
          34             :     real(r8), intent(in) :: gravit_in, rair_in
          35             :
          36             :     character(len=*), intent(out) :: errstring
          37             :
          38        1536 :     errstring = ' '
          39             :
          40        1536 :     if ( kind /= r8 ) then
          41           0 :        errstring = 'inconsistent KIND of reals passed to init_blj'
          42           0 :        return
          43             :     endif
          44             :
          45        1536 :    gravit   = gravit_in
          46        1536 :    rair     = rair_in
          47             :
          48        1536 :   end subroutine init_blj
          49             :
          50             :   !============================================================================ !
          51             :   !                                                                             !
          52             :   !============================================================================ !
          53             :
          54     1489176 :   subroutine compute_blj( pcols    , pver    , ncol    ,                     &
          55     1489176 :                           u        , v       , t       , pmid    , delp    , &
          56     1489176 :                           zm       , sgh     , drag    , taux    , tauy    , &
          57             :                           landfrac )
          58             :
          59             :     !------------------------------------------------------------------------------ !
          60             :     ! Beljaars Sub-Grid Orographic (SGO) Form drag parameterization                 !
          61             :     !                                                                               !
          62             :     ! Returns drag profile and integrated stress associated with subgrid mountains  !
          63             :     ! with horizontal length scales nominally below 3km.  Similar to TMS but        !
          64             :     ! drag is distributed in the vertical (Beljaars et al., 2003, QJRMS).           !
          65             :     !                                                                               !
          66             :     ! First cut follows TMS.     J. Bacmeister, March 2016                          !
          67             :     !------------------------------------------------------------------------------ !
          68             :
          69             :     ! ---------------------- !
          70             :     ! Input-Output Arguments !
          71             :     ! ---------------------- !
          72             :
          73             :     integer,  intent(in)  :: pcols                 ! Number of columns dimensioned
          74             :     integer,  intent(in)  :: pver                  ! Number of model layers
          75             :     integer,  intent(in)  :: ncol                  ! Number of columns actually used
          76             :
          77             :     real(r8), intent(in)  :: u(pcols,pver)         ! Layer mid-point zonal wind [ m/s ]
          78             :     real(r8), intent(in)  :: v(pcols,pver)         ! Layer mid-point meridional wind [ m/s ]
          79             :     real(r8), intent(in)  :: t(pcols,pver)         ! Layer mid-point temperature [ K ]
          80             :     real(r8), intent(in)  :: pmid(pcols,pver)      ! Layer mid-point pressure [ Pa ]
          81             :     real(r8), intent(in)  :: delp(pcols,pver)      ! Layer thickness [ Pa ]
          82             :     real(r8), intent(in)  :: zm(pcols,pver)        ! Layer mid-point height [ m ]
          83             :     real(r8), intent(in)  :: sgh(pcols)            ! Standard deviation of orography [ m ]
          84             :     real(r8), intent(in)  :: landfrac(pcols)       ! Land fraction [ fraction ]
          85             :
          86             :     real(r8), intent(out) :: drag(pcols,pver)      ! SGO drag profile [ kg/s/m2 ]
          87             :     real(r8), intent(out) :: taux(pcols)           ! Surface zonal      wind stress [ N/m2 ]
          88             :     real(r8), intent(out) :: tauy(pcols)           ! Surface meridional wind stress [ N/m2 ]
          89             :
          90             :     ! --------------- !
          91             :     ! Local Variables !
          92             :     ! --------------- !
          93             :
          94             :     integer  :: i,k                                ! Loop indices
          95             :     integer  :: kb, kt                             ! Bottom and top of source region
          96             :
          97             :     real(r8) :: vmag                               ! Velocity magnitude [ m /s ]
          98             :
          99             :     real(r8) :: alpha,beta,Cmd,Ccorr,n1,n2,k1,kflt,k2,IH
         100     2978352 :     real(r8) :: a1(pcols),a2(pcols)
         101             :
         102     1489176 :     alpha =  12._r8
         103     1489176 :     beta  =  1._r8
         104     1489176 :     n1    = -1.9_r8
         105     1489176 :     n2    = -2.8_r8
         106             :
         107     1489176 :     Cmd   = 0.005_r8
         108     1489176 :     Ccorr = 0.6_r8 * 5._r8
         109             :
         110     1489176 :     kflt  = 0.00035_r8  ! m-1
         111     1489176 :     k1    = 0.003_r8    ! m-1
         112     1489176 :     IH    = 0.00102_r8  ! m-1
         113             :
         114    24865776 :     a1(1:ncol)    = (sgh(1:ncol)*sgh(1:ncol)) / ( IH* (kflt**n1) )
         115    24865776 :     a2(1:ncol)    = a1(1:ncol) * k1**(n1-n2)
         116             :
         117             :
         118             :     ! ----------------------- !
         119             :     ! Main Computation Begins !
         120             :     ! ----------------------- !
         121             :
         122   139982544 :     do k = 1, pver
         123  2314006344 :     do i = 1, ncol
         124  2174023800 :        Vmag      = SQRT( u(i,k)**2 + v(i,k)**2)
         125             :        drag(i,k) = -alpha * beta * Cmd * Ccorr * Vmag * 2.109_r8 *  &
         126             :                    EXP ( -(zm(i,k)/1500._r8 )*SQRT(zm(i,k)/1500._r8) ) * ( zm(i,k)**(-1.2_r8) )  &
         127  2312517168 :                    * a2(i)
         128             :     end do
         129             :     end do
         130             :
         131             :
         132             :     !---------------------------------!
         133             :     ! Diagnose effective surface drag !
         134             :     ! in X and Y by integrating in    !
         135             :     ! the vertical                    !
         136             :     !---------------------------------!
         137             :     ! FIXME: uses 'state' u and v.
         138             :     ! Should updated u and v's be used?
         139             :
         140    25315992 :     taux=0._r8
         141    25315992 :     tauy=0._r8
         142   139982544 :     do k = 1, pver
         143  2314006344 :     do i = 1, ncol
         144  2174023800 :        taux(i)  = taux(i) + drag(i,k)*u(i,k)*delp(i,k)/gravit
         145  2312517168 :        tauy(i)  = tauy(i) + drag(i,k)*v(i,k)*delp(i,k)/gravit
         146             :     end do
         147             :     end do
         148             :
         149     1489176 :     return
         150             :   end subroutine compute_blj
         151             :
         152             : end module beljaars_drag

Generated by: LCOV version 1.14