var/da/da_physics/da_find_layer_adj.inc

   1 subroutine da_find_layer_adj (layer,tv,pre,pre_ma,tv_ma,ks,ke,ADJ_tv,ADJ_pre_ma,ADJ_tv_ma)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: adjoint routine for da_find_layer
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    integer, intent(in)    :: ks, ke
  10    integer, intent(out)   :: layer
  11    real,    intent(in)    :: pre_ma(ks-1:ke+1)
  12    real,    intent(in)    :: tv_ma(ks-1:ke+1)
  13    real,    intent(inout) :: ADJ_pre_ma(ks-1:ke+1)
  14    real,    intent(inout) :: ADJ_tv_ma(ks-1:ke+1)
  15    real,    intent(in)    :: pre, tv
  16    real,    intent(inout) :: ADJ_tv
  17
  18    integer :: k
  19    real    :: alpha, coef1, coef2
  20    real    :: ADJ_alpha
  21
  22    if (trace_use_frequent) call da_trace_entry("da_find_layer_adj")
  23
  24    if (pre >= pre_ma(ks)) then
  25       layer = ks
  26       coef1=log(pre/pre_ma(ks+1))/(pre_ma(ks)*     &
  27             (log(pre_ma(ks)/pre_ma(ks+1)))**2)
  28       coef2=log(pre_ma(ks)/pre)/(pre_ma(ks+1)*     &
  29             (log(pre_ma(ks)/pre_ma(ks+1)))**2)
  30       alpha = log(pre_ma(ks)/pre)/log(pre_ma(ks)/pre_ma(ks+1))
  31
  32       ADJ_pre_ma(ks-1)= 0.0
  33       ADJ_tv_ma(ks)   = ADJ_tv_ma(ks) + (1.0-alpha)*ADJ_tv
  34       ADJ_alpha        = (tv_ma(ks+1)-tv_ma(ks))*ADJ_tv
  35       ADJ_tv_ma(ks+1) = ADJ_tv_ma(ks+1) + alpha*ADJ_tv
  36
  37       ADJ_pre_ma(ks)    = ADJ_pre_ma(ks) + coef1 * ADJ_alpha
  38       ADJ_pre_ma(ks+1)  = ADJ_pre_ma(ks+1) + coef2 * ADJ_alpha
  39    else if (pre <= pre_ma(ke)) then
  40       layer = ke+1
  41       coef1=log(pre/pre_ma(ke))/(pre_ma(ke-1)*           &
  42             (log(pre_ma(ke-1)/pre_ma(ke)))**2)
  43       coef2=log(pre_ma(ke-1)/pre)/(pre_ma(ke)*           &
  44             (log(pre_ma(ke-1)/pre_ma(ke)))**2)
  45       alpha = log(pre_ma(ke-1)/pre)/log(pre_ma(ke-1)/pre_ma(ke))
  46
  47       ADJ_pre_ma(ke+1)    = 0.0
  48       ADJ_tv_ma(ke-1)     = ADJ_tv_ma(ke-1) + (1.0-alpha)*ADJ_tv
  49       ADJ_alpha        = (tv_ma(ke)-tv_ma(ke-1))*ADJ_tv
  50       ADJ_tv_ma(ke)     = ADJ_tv_ma(ke) + alpha*ADJ_tv
  51
  52       ADJ_pre_ma(ke-1) = ADJ_pre_ma(ke-1) + coef1 * ADJ_alpha
  53       ADJ_pre_ma(ke) = ADJ_pre_ma(ke) + coef2 * ADJ_alpha
  54    else
  55       do k=ks,ke-1
  56          if (pre>=pre_ma(k+1) .and. pre<pre_ma(k)) then
  57             layer = k+1
  58             coef1=log(pre/pre_ma(k+1))/(pre_ma(k)*   &
  59                   (log(pre_ma(k)/pre_ma(k+1)))**2)
  60             coef2=log(pre_ma(k)/pre)/(pre_ma(k+1)*   &
  61                   (log(pre_ma(k)/pre_ma(k+1)))**2)
  62             alpha = log(pre_ma(k)/pre)/log(pre_ma(k)/pre_ma(k+1))
  63
  64             ADJ_tv_ma(k)     = ADJ_tv_ma(k) + (1.0-alpha)*ADJ_tv
  65             ADJ_alpha        = (tv_ma(k+1)-tv_ma(k))*ADJ_tv
  66             ADJ_tv_ma(k+1)   = ADJ_tv_ma(k+1) + alpha * ADJ_tv
  67
  68             ADJ_pre_ma(k)   = ADJ_pre_ma(k) + coef1 * ADJ_alpha
  69             ADJ_pre_ma(k+1) = ADJ_pre_ma(k+1) + coef2 * ADJ_alpha
  70             exit
  71          end if
  72       end do
  73    end if
  74
  75    ADJ_tv           = 0.0
  76
  77    if (trace_use_frequent) call da_trace_exit("da_find_layer_adj")
  78
  79 end subroutine da_find_layer_adj
  80
  81