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 
33             pertile_lhs = pertile_lhs + &
34              ( y%instid(inst)%tb(k,n)/iv%instid(inst)%tb_error(k,n) )**2
35 
36             y%instid(inst)%tb(k,n) =  &
37               y%instid(inst)%tb(k,n) / (iv%instid(inst)%tb_error(k,n))**2
38          end do
39          ! end if
40       end do
41    end do 
42 
43    if (trace_use_dull) call da_trace_exit("da_check_xtoy_adjoint_rad")
44 
45 end subroutine da_check_xtoy_adjoint_rad
46 
47