var/da/da_test/da_check_xtoy_adjoint_rad.inc

   1 subroutine da_check_xtoy_adjoint_rad(iv, y, adjtest_lhs, pertile_lhs)
   2
   3    !------------------------------------------------------------------------------
   4    ! Purpose: Calculate innovation vector for radiance data.
   5    !------------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type(iv_type), intent(in)     :: iv            ! obs. inc. vector (o-b).
  10    type(y_type),  intent(inout)  :: y             ! y = h (xa)
  11    real,          intent(inout)  :: adjtest_lhs, pertile_lhs
  12
  13    integer :: inst, n, k          ! Loop counter.
  14
  15    if (trace_use_dull) call da_trace_entry("da_check_xtoy_adjoint_rad")
  16
  17    do inst = 1, iv%num_inst                 ! loop for sensor
  18       if (iv%instid(inst)%num_rad < 1) cycle
  19
  20       do n= 1, iv%instid(inst)%num_rad       ! loop for pixel
  21          ! if (iv%instid(inst)%rad(n)%loc%proc_domain_with_halo) then
  22          if (iv%instid(inst)%info%proc_domain(1,n)) then
  23             do k = 1, iv%instid(inst)%nchan
  24                ! if ( iv%instid(inst)%tb_qc(k,n) >= obs_qc_pointer ) &
  25                adjtest_lhs = adjtest_lhs + &
  26                  ( y%instid(inst)%tb(k,n)/iv%instid(inst)%tb_error(k,n) )**2
  27             end do
  28          end if
  29
  30          do k=1, iv%instid(inst)%nchan
  31             ! if ( iv%instid(inst)%tb_qc(k,n) >= obs_qc_pointer ) &
  32             pertile_lhs = pertile_lhs + &
  33              ( y%instid(inst)%tb(k,n)/iv%instid(inst)%tb_error(k,n) )**2
  34
  35             y%instid(inst)%tb(k,n) =  &
  36               y%instid(inst)%tb(k,n) / (iv%instid(inst)%tb_error(k,n))**2
  37          end do
  38          ! end if
  39       end do
  40    end do
  41
  42    if (trace_use_dull) call da_trace_exit("da_check_xtoy_adjoint_rad")
  43
  44 end subroutine da_check_xtoy_adjoint_rad
  45
  46