LCOV - code coverage report
Current view: | top level - physics/cam - flux_avg.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 77 | 0.0 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 0 | 4 | 0.0 %

              Line data    Source code
           1             : module flux_avg
           2             :
           3             : !---------------------------------------------------------------------------------
           4             : ! Purpose: Contains code to smooth the surface fluxes to reduce
           5             : !          instabilities in the surface layer.
           6             : !---------------------------------------------------------------------------------
           7             :
           8             :   use shr_kind_mod,     only: r8=>shr_kind_r8
           9             :   use ppgrid,           only: begchunk, endchunk, pcols
          10             :
          11             :   use physics_types,    only: physics_state
          12             :   use camsrfexch,       only: cam_in_t
          13             :   use phys_grid,        only: get_ncols_p
          14             :   use physics_buffer, only : pbuf_add_field, dtype_r8
          15             :   implicit none
          16             :   private
          17             :   save
          18             :
          19             :   ! Public interfaces
          20             :
          21             :   public :: flux_avg_register
          22             :   public :: flux_avg_init
          23             :   public :: flux_avg_run
          24             :
          25             :   ! Private module data
          26             :
          27             :   integer :: lhflx_idx      ! lhflx index in physics buffer
          28             :   integer :: shflx_idx      ! shflx index in physics buffer
          29             :   integer :: qflx_idx       ! qflx index in physics buffer
          30             :   integer :: taux_idx       ! taux index in physics buffer
          31             :   integer :: tauy_idx       ! tauy index in physics buffer
          32             :   integer :: lhflx_res_idx  ! lhflx_res index in physics buffer
          33             :   integer :: shflx_res_idx  ! shflx_res index in physics buffer
          34             :   integer :: qflx_res_idx   ! qflx_res index in physics buffer
          35             :   integer :: taux_res_idx   ! taux_res index in physics buffer
          36             :   integer :: tauy_res_idx   ! tauy_res index in physics buffer
          37             :
          38             : !===============================================================================
          39             : contains
          40             : !===============================================================================
          41             :
          42           0 : subroutine flux_avg_register()
          43             :
          44             :    !----------------------------------------------------------------------
          45             :    !
          46             :    ! Register the fluxes in the physics buffer.
          47             :    !
          48             :    !-----------------------------------------------------------------------
          49             :
          50             :    ! Request physics buffer space for fields that persist across timesteps.
          51           0 :    call pbuf_add_field('LHFLX',    'global',dtype_r8,(/pcols,1/),lhflx_idx)
          52           0 :    call pbuf_add_field('SHFLX',    'global',dtype_r8,(/pcols,1/),shflx_idx)
          53           0 :    call pbuf_add_field('TAUX',     'global',dtype_r8,(/pcols,1/),taux_idx)
          54           0 :    call pbuf_add_field('TAUY',     'global',dtype_r8,(/pcols,1/),tauy_idx)
          55           0 :    call pbuf_add_field('QFLX',     'global',dtype_r8,(/pcols,1/),qflx_idx)
          56           0 :    call pbuf_add_field('LHFLX_RES','global',dtype_r8,(/pcols,1/),lhflx_res_idx)
          57           0 :    call pbuf_add_field('SHFLX_RES','global',dtype_r8,(/pcols,1/),shflx_res_idx)
          58           0 :    call pbuf_add_field('TAUX_RES', 'global',dtype_r8,(/pcols,1/),taux_res_idx)
          59           0 :    call pbuf_add_field('TAUY_RES', 'global',dtype_r8,(/pcols,1/),tauy_res_idx)
          60           0 :    call pbuf_add_field('QFLX_RES', 'global',dtype_r8,(/pcols,1/),qflx_res_idx)
          61             :
          62           0 : end subroutine flux_avg_register
          63             :
          64             : !===============================================================================
          65             :
          66           0 : subroutine flux_avg_init(cam_in,  pbuf2d)
          67             :   use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk
          68             :    ! Initialize the surface fluxes in the physics buffer using the cam import state
          69             :
          70             :    type(cam_in_t),      intent(in)    :: cam_in(begchunk:endchunk)
          71             :
          72             :    type(physics_buffer_desc), pointer :: pbuf2d(:,:)
          73             :    integer :: lchnk
          74             :    integer :: ncol
          75           0 :    type(physics_buffer_desc), pointer :: pbuf2d_chunk(:)
          76             :
          77             :    !-----------------------------------------------------------------------
          78             :
          79           0 :    do lchnk = begchunk, endchunk
          80           0 :       ncol = get_ncols_p(lchnk)
          81           0 :       pbuf2d_chunk => pbuf_get_chunk(pbuf2d, lchnk)
          82           0 :       call pbuf_set_field(pbuf2d_chunk, lhflx_idx,  cam_in(lchnk)%lhf(:ncol))
          83           0 :       call pbuf_set_field(pbuf2d_chunk, shflx_idx,  cam_in(lchnk)%shf(:ncol))
          84           0 :       call pbuf_set_field(pbuf2d_chunk, qflx_idx,   cam_in(lchnk)%cflx(:ncol,1))
          85           0 :       call pbuf_set_field(pbuf2d_chunk, taux_idx,   cam_in(lchnk)%wsx(:ncol))
          86           0 :       call pbuf_set_field(pbuf2d_chunk, tauy_idx,   cam_in(lchnk)%wsy(:ncol))
          87             :
          88           0 :       call pbuf_set_field(pbuf2d,       shflx_res_idx, 0.0_r8)
          89           0 :       call pbuf_set_field(pbuf2d_chunk, lhflx_res_idx, 0.0_r8)
          90           0 :       call pbuf_set_field(pbuf2d_chunk, qflx_res_idx,  0.0_r8)
          91           0 :       call pbuf_set_field(pbuf2d_chunk, taux_res_idx,  0.0_r8)
          92           0 :       call pbuf_set_field(pbuf2d_chunk, tauy_res_idx,  0.0_r8)
          93             :    end do
          94             :
          95             :
          96           0 : end subroutine flux_avg_init
          97             :
          98             : !===============================================================================
          99             :
         100           0 : subroutine flux_avg_run(state, cam_in,  pbuf, nstep, deltat)
         101           0 :   use physics_buffer, only : physics_buffer_desc, pbuf_get_field
         102             :    !-----------------------------------------------------------------------
         103             :    !
         104             :    ! Purpose:
         105             :    !
         106             :    !-----------------------------------------------------------------------
         107             :
         108             :    ! Input arguments
         109             :
         110             :    type(physics_state), intent(in)    :: state
         111             :    type(cam_in_t),      intent(inout) :: cam_in
         112             :    type(physics_buffer_desc), pointer :: pbuf(:)
         113             :
         114             :    integer,             intent(in)    :: nstep
         115             :    real(r8),            intent(in)    :: deltat
         116             :
         117             :    ! Local variables
         118             :    integer :: lchnk                  ! chunk identifier
         119             :    integer :: ncol                   ! number of atmospheric columns
         120             :
         121             :    ! physics buffer fields
         122           0 :    real(r8), pointer, dimension(:) :: lhflx   ! latent heat flux
         123           0 :    real(r8), pointer, dimension(:) :: shflx   ! sensible heat flux
         124           0 :    real(r8), pointer, dimension(:) :: qflx    ! water vapor heat flux
         125           0 :    real(r8), pointer, dimension(:) :: taux    ! x momentum flux
         126           0 :    real(r8), pointer, dimension(:) :: tauy    ! y momentum flux
         127           0 :    real(r8), pointer, dimension(:) :: lhflx_res   ! latent heat flux
         128           0 :    real(r8), pointer, dimension(:) :: shflx_res   ! sensible heat flux
         129           0 :    real(r8), pointer, dimension(:) :: qflx_res    ! water vapor heat flux
         130           0 :    real(r8), pointer, dimension(:) :: taux_res    ! x momentum flux
         131           0 :    real(r8), pointer, dimension(:) :: tauy_res    ! y momentum flux
         132             :    !-----------------------------------------------------------------------
         133             :
         134           0 :    lchnk = state%lchnk
         135           0 :    ncol  = state%ncol
         136             :
         137             :    ! Associate pointers with physics buffer fields
         138           0 :    call pbuf_get_field(pbuf, lhflx_idx,     lhflx )
         139           0 :    call pbuf_get_field(pbuf, shflx_idx,     shflx )
         140           0 :    call pbuf_get_field(pbuf, qflx_idx,      qflx  )
         141           0 :    call pbuf_get_field(pbuf, taux_idx,      taux  )
         142           0 :    call pbuf_get_field(pbuf, tauy_idx,      tauy  )
         143             :
         144           0 :    call pbuf_get_field(pbuf, lhflx_res_idx, lhflx_res )
         145           0 :    call pbuf_get_field(pbuf, shflx_res_idx, shflx_res )
         146           0 :    call pbuf_get_field(pbuf, qflx_res_idx,  qflx_res  )
         147           0 :    call pbuf_get_field(pbuf, taux_res_idx,  taux_res  )
         148           0 :    call pbuf_get_field(pbuf, tauy_res_idx,  tauy_res  )
         149             :
         150           0 :    call smooth (cam_in%lhf, lhflx, lhflx_res, nstep, deltat, ncol)
         151           0 :    call smooth (cam_in%shf, shflx, shflx_res, nstep, deltat, ncol)
         152           0 :    call smooth (cam_in%wsx, taux, taux_res, nstep, deltat, ncol)
         153           0 :    call smooth (cam_in%wsy, tauy, tauy_res, nstep, deltat, ncol)
         154           0 :    call smooth (cam_in%cflx(:pcols,1), qflx, qflx_res, nstep, deltat, ncol)
         155             :
         156           0 : end subroutine flux_avg_run
         157             :
         158             : !===============================================================================
         159             :
         160           0 : subroutine smooth(new, old, res, nstep, deltat, ncol)
         161             :
         162             :    real(r8), intent(inout) :: new(pcols)
         163             :    real(r8), intent(inout) :: old(pcols)
         164             :    real(r8), intent(inout) :: res(pcols)
         165             :    real(r8), intent(in)    :: deltat
         166             :    integer,  intent(in)    :: nstep
         167             :    integer,  intent(in)    :: ncol
         168             :
         169             :    real(r8) :: temp(pcols)
         170             :    integer i
         171             :
         172           0 :    temp(1:ncol) = new(1:ncol)
         173           0 :    if (nstep > 0) then
         174           0 :       new(1:ncol) = 0.5_r8*(new(1:ncol)+old(1:ncol))
         175             :    else
         176           0 :       old(1:ncol) = new(1:ncol)
         177           0 :       res(1:ncol) = 0._r8
         178             :    endif
         179             :
         180             :    ! storing the old value for smoothing on the next step
         181             :    ! doesnt seem to be stable
         182             :    ! old(1:ncol) = temp(1:ncol)
         183             :
         184             :    ! storing the smoothed value for the next step
         185             :
         186             :    ! first add the flux that the surface model wanted to provide less
         187             :    ! the flux the atmosphere will actually see to the residual
         188           0 :    res(1:ncol) = res(1:ncol) + temp(1:ncol)-new(1:ncol)
         189             :
         190             :    ! now calculate the amount that we might increment the new flux
         191             :    ! to include some of the residual
         192             :    ! If the residual is small we will just add it all,
         193             :    ! but if it is large we will add it at the rate required to put
         194             :    ! the residual back into the flux over a 2 hour period
         195           0 :    do i = 1,ncol
         196           0 :       if (abs(res(i)).lt.max(abs(new(i)),abs(old(i)))*0.05_r8) then
         197           0 :          temp(i) = res(i)
         198           0 :          res(i) = 0._r8
         199             :       else
         200           0 :          temp(i) = res(i)*deltat/7200._r8
         201             :          !     temp(i) = res(i)*deltat*0.5/7200.
         202           0 :          res(i) = res(i)-temp(i)
         203             :       endif
         204             :    end do
         205             :
         206             :    ! dont do conservative smoothing for first 12 hours
         207           0 :    if (nstep*deltat/86400._r8 < 0.5_r8) then
         208             :       ! use this line if your dont want to use the residual
         209             :       !if (.true.) then
         210           0 :       temp = 0._r8
         211           0 :       res = 0._r8
         212             :    endif
         213             :
         214             :    ! make the new flux the average of the sfc model and last timestep
         215             :    ! plus some of the residual
         216           0 :    new(1:ncol) = new(1:ncol) + temp(1:ncol)
         217           0 :    old(1:ncol) = new(1:ncol)
         218             :
         219           0 : end subroutine smooth
         220             :
         221             : !===============================================================================
         222             :
         223             : end module flux_avg
         224             :

Generated by: LCOV version 1.14