var/da/da_setup_structures/da_get_bins_info.inc

   1 subroutine da_get_bins_info(nj, nk, bin2d, evec_g, eval_g,&
   2                   evec_loc, eval_loc, max_vert_var, var_scaling, be_sub)
   3
   4    !---------------------------------------------------------------------------
   5    !  Purpose: Extracts Eigen vectors/values info from bins
   6    !           and builds up background error structure
   7    !---------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    integer, intent(in)    :: nj, nk       ! W-E, S-N and Vert. Dims
  12    integer, intent(in)    :: bin2d(:,:)       ! Bin assigned to each 2D
  13    real*8,  intent(in)    :: evec_g(:,:)      ! Global Eig. vectors
  14    real*8,  intent(in)    :: eval_g(:)        ! Global Eig. values
  15    real*8,  intent(in)    :: evec_loc(:,:,:)  ! Local Eig. vectors
  16    real*8,  intent(in)    :: eval_loc(:,:)    ! Local Eig. values
  17    real,    intent(in)    :: max_vert_var     ! Vertical variance
  18    real,    intent(in)    :: var_scaling      ! Variance re-scaling factor
  19    type(be_subtype), intent(inout) :: be_sub ! Background error structure
  20
  21    real*8, allocatable    :: e_vec_loc(:,:,:)
  22    real*8, allocatable    :: e_val_loc(:,:)
  23
  24    integer               :: i, j, k, b
  25
  26    !---------------------------------------------------------------------------
  27
  28    if (trace_use) call da_trace_entry("da_get_bins_info")
  29
  30    allocate(e_vec_loc(1:nj,1:nk,1:nk))
  31    allocate(e_val_loc(1:nj,1:nk))
  32    if (vert_evalue == vert_evalue_global) then       ! use global eigen vectors
  33       do k = 1, nk
  34          e_val_loc(1:nj,k)     = eval_g(k)
  35          do i =1,nk
  36             e_vec_loc(1:nj,k,i) = evec_g(k,i)
  37          end do
  38       end do
  39
  40    else if (vert_evalue == vert_evalue_local) then  ! use local  eigen vectors
  41       do j = 1, nj
  42          b = bin2d(1,j)
  43          do k=1,nk
  44            e_val_loc(j,k)   = eval_loc(k,b)
  45            do i = 1,nk
  46               e_vec_loc(j,k,i) = evec_loc(k,i,b)
  47             end do
  48          end do
  49       end do
  50    else
  51       write(unit=message(1),fmt='(A,I5)') &
  52          "Invalid value of vert_evalue=",vert_evalue
  53       call da_error(__FILE__,__LINE__,message(1:1))
  54    end if
  55
  56    call da_get_vertical_truncation(max_vert_var, eval_g, be_sub)
  57    call da_allocate_background_errors(nj, nk, eval_g, evec_g, &
  58       e_val_loc, e_vec_loc, be_sub)
  59    if (be_sub%mz > 0) be_sub%val(:,:) = var_scaling * be_sub%val(:,:)
  60    deallocate( e_vec_loc)
  61    deallocate( e_val_loc)
  62
  63    if (trace_use) call da_trace_exit("da_get_bins_info")
  64
  65 end subroutine da_get_bins_info
  66
  67