var/da/da_setup_structures/da_get_vertical_truncation.inc

   1 subroutine da_get_vertical_truncation( max_vert_var, eigenval, be_sub)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: Calculate vertical mode truncation from explained variance.
   5    !
   6    !  Method:  Calculate cumulative variance and compare with limit.
   7    !---------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    real, intent(in)                 :: max_vert_var    ! Vertical variance limit.
  12    real*8, intent(in)               :: eigenval(:)     ! Global eigenvaluess.
  13    type(be_subtype), intent(inout) :: be_sub          ! Back. error sub type.
  14
  15    integer                          :: kz              ! # vertical levels.
  16    integer                          :: k               ! Loop counter.
  17    real*8                           :: tot_variance    ! Total variance.
  18    real*8                           :: cum_variance    ! Cumulative variance.
  19    character(LEN = 6)              :: name            ! Variable name.
  20
  21    if (trace_use_dull) call da_trace_entry("da_get_vertical_truncation")
  22
  23
  24    !---------------------------------------------------------------------------
  25    ! [1.0] Initialise:
  26    !---------------------------------------------------------------------------
  27
  28    kz = size( eigenval(:))
  29    name = trim(be_sub % name)
  30
  31    !---------------------------------------------------------------------------
  32    ! [2.0] Calculate vertical truncation:
  33    !---------------------------------------------------------------------------
  34
  35    if (max_vert_var >= 100.0) then
  36
  37       ! [2.1] No truncation:
  38       be_sub % mz = kz
  39
  40       ! Disregard zero/-ve eigenvalues(which should be very small and only
  41       ! appear if statistics have been interpolated between domains):
  42
  43       do k = 1, kz
  44          if (eigenval(k) <= 0.0) then
  45             be_sub % mz = k - 1
  46             exit
  47          end if
  48       end do
  49    else
  50
  51       ! [2.2] Calculate cumulative variance and truncate:
  52
  53       tot_variance = sum( eigenval(1:kz))
  54       cum_variance = 0.0
  55
  56       do k = 1, kz
  57          cum_variance = cum_variance + eigenval(k)
  58
  59          if (eigenval(k) <= 1e-12) then   ! Ha: Ignore trivial fields (ex. naaj, naai and seas)
  60          !if (eigenval(k) <= 0.0) then
  61             be_sub % mz = k - 1
  62             exit
  63          end if
  64
  65          if (cum_variance/tot_variance >= 0.01 * max_vert_var) then
  66             be_sub % mz = k
  67             exit
  68          end if
  69       end do
  70
  71       if (max_vert_var == 0.0) be_sub % mz = 0
  72       if (be_sub % mz  == 0.0) be_sub % mz = 1    ! HA - to avoid segmentation fault
  73
  74    end if
  75
  76    write(unit=stdout,fmt='(A,A6,A3,I3,A1,f7.2,A2)') &
  77       'Vertical truncation for ', name, &
  78       ' = ', be_sub % mz, '(', &
  79       max_vert_var, '%)'
  80    !write (unit=stdout,fmt='(A)') " "
  81
  82    if (trace_use_dull) call da_trace_exit("da_get_vertical_truncation")
  83
  84 end subroutine da_get_vertical_truncation
  85
  86