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 (ob_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 (iv%num_inst < 1) return
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)%proc_domain(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 end subroutine da_check_xtoy_adjoint_rad
44 
45