wrfv2_fire/var/da/da_setup_structures/da_rescale_background_errors.inc

   1 subroutine da_rescale_background_errors (var_scaling, len_scaling, &
   2                                           ds, s, be_sub)
   3
   4    !---------------------------------------------------------------------------
   5    ! Purpose: Rescale wrfvar background errors.
   6    !
   7    ! Method:  Empirical scaling and inclusion of recursive filter rescaling.
   8    !---------------------------------------------------------------------------
   9
  10    implicit none
  11
  12    real, intent(in)                 :: var_scaling       ! Variance factor.
  13    real, intent(in)                 :: len_scaling       ! Lengthscale factor.
  14    real, intent(in)                 :: ds                ! Resolution (m)
  15    real, intent(inout)              :: s(:)              ! RF lengthscale.
  16    type (be_subtype), intent(inout) :: be_sub            ! Backgrd error struct.
  17
  18    integer                          :: mz                ! Vertical truncation.
  19    integer                          :: m
  20    real, allocatable                :: rf_scale_factor(:)! RF rescaling.
  21
  22    if (trace_use_dull) call da_trace_entry("da_rescale_background_errors")
  23
  24    write(unit=stdout,fmt='(3x,"Scaling: var, len, ds:",3e15.6 )') &
  25                                      var_scaling, len_scaling, ds
  26
  27    !--------------------------------------------------------------------------
  28    ! [1.0] Initialise:
  29    !--------------------------------------------------------------------------
  30
  31    mz = be_sub % mz
  32
  33    !--------------------------------------------------------------------------
  34    ! [2.0] Perform various rescalings:
  35    !--------------------------------------------------------------------------
  36
  37    if (mz > 0) then
  38
  39       ! [2.1] Empirical rescaling of lengthscales:
  40       s(1:mz) = len_scaling * s(1:mz)
  41
  42       if (print_detail_be) then
  43          write(unit=stdout,fmt='(a,a)')trim(be_sub % name), ' Error Lengthscales (m):'
  44          do m = 1, mz
  45             write(unit=stdout,fmt='(a,i4,1pe13.5)')be_sub % name, m, s(m)
  46          end do
  47       end if
  48
  49       ! [2.2] Make lengthscale nondimensional:
  50       s(1:mz) = s(1:mz) / ds
  51
  52       ! [2.3] Empirical rescaling of variances:
  53       be_sub % val(:,:) = var_scaling * be_sub % val(:,:)
  54
  55       ! Calculate recursive filter rescaling:
  56
  57       allocate(rf_scale_factor(1:mz))
  58
  59       call da_calculate_rf_factors(s(:), be_sub % rf_alpha(:), &
  60                                     rf_scale_factor(:))
  61
  62       do m = 1, mz
  63          be_sub % val(:,m) = rf_scale_factor(m) * be_sub % val(:,m)
  64       end do
  65
  66       deallocate (rf_scale_factor)
  67
  68    end if
  69
  70    if (trace_use_dull) call da_trace_exit("da_rescale_background_errors")
  71
  72 end subroutine da_rescale_background_errors
  73
  74