da_jo_and_grady_rad.inc

1 subroutine da_jo_and_grady_rad(iv, re, jo, jo_grad_y) 
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Calculate Gradient_y i and cost function Jo for radiance data.
5    !
6    ! Method:  grad_y = -R^-1 (d - H delta_x)
7    !              Jo = -(d - H delta_x) grad_y
8    !---------------------------------------------------------------------------
9 
10    implicit none
11 
12    type (ob_type), intent(in)    :: iv          ! Innovation vector.
13    type (y_type) , intent(in)    :: re          ! Residual vector.
14    type (y_type) , intent(inout) :: jo_grad_y   ! Grad_y(Jo)
15    type (jo_type), intent(inout) :: jo          ! Obs cost function.
16 
17    integer                       :: n, k, i
18 
19    if (iv%num_inst < 1) return
20 
21    if (trace_use) call da_trace_entry("da_jo_and_grady_rad")
22 
23    do i =1, iv%num_inst
24 
25       jo % rad(i)%jo_ichan(:) = 0.0
26       jo % rad(i)%num_ichan(:) = 0
27 
28       if (iv%instid(i)%num_rad < 1 .or. iv%instid(i)%rad_monitoring == monitor_on ) cycle
29 
30       do n=1, iv%instid(i)%num_rad
31          do k=1, iv%instid(i)%nchan
32             jo_grad_y%instid(i)%tb(k,n) = -re%instid(i)%tb(k,n) / &
33                                     (iv%instid(i)%tb_error(k,n) * &
34                                       iv%instid(i)%tb_error(k,n))
35          end do
36          if (iv%instid(i)%proc_domain(n)) then
37             do k=1, iv%instid(i)%nchan
38                if (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer) then
39                   jo % rad(i) % jo_ichan(k) = jo % rad(i) % jo_ichan(k) - &
40                      re%instid(i)%tb(k,n) * jo_grad_y%instid(i)%tb(k,n)
41                   jo % rad(i) % num_ichan(k) = jo % rad(i) % num_ichan(k) + 1
42                end if
43             end do
44          end if
45       end do
46       jo % rad(i)%jo_ichan(:) = 0.5 * jo % rad(i)%jo_ichan(:)
47    end do
48 
49    if (trace_use) call da_trace_exit("da_jo_and_grady_rad")
50 
51 end subroutine da_jo_and_grady_rad
52 
53