Update version info for release v4.6.1 (#2122)
[WRF.git] / var / da / da_radiance / da_jo_and_grady_rad.inc
blob362745223e35af4f289188cf92efbc68cda6926f
1 subroutine da_jo_and_grady_rad(iv, re, jo, jo_grad_y) 
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    !---------------------------------------------------------------------------
10    implicit none
12    type (iv_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.
17    integer                       :: n, k, i
19    if (trace_use) call da_trace_entry("da_jo_and_grady_rad")
21    do i =1, iv%num_inst
23       jo % rad(i)%jo_ichan(:) = 0.0
24       jo % rad(i)%num_ichan(:) = 0
26       if (iv%instid(i)%num_rad < 1 .or. iv%instid(i)%rad_monitoring == monitor_on ) cycle
28       do n=1, iv%instid(i)%num_rad
29          do k=1, iv%instid(i)%nchan
30             jo_grad_y%instid(i)%tb(k,n) = -re%instid(i)%tb(k,n) / &
31                (iv%instid(i)%tb_error(k,n) * iv%instid(i)%tb_error(k,n))
32          end do
33          if (iv%instid(i)%info%proc_domain(1,n)) then
34             do k=1, iv%instid(i)%nchan
35                if (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer) then
36                   jo % rad(i) % jo_ichan(k) = jo % rad(i) % jo_ichan(k) - &
37                      re%instid(i)%tb(k,n) * jo_grad_y%instid(i)%tb(k,n)
38                   jo % rad(i) % num_ichan(k) = jo % rad(i) % num_ichan(k) + 1
39                end if
40             end do
41          end if
42       end do
43       jo % rad(i)%jo_ichan(:) = 0.5 * jo % rad(i)%jo_ichan(:)
44    end do
46    if (trace_use) call da_trace_exit("da_jo_and_grady_rad")
48 end subroutine da_jo_and_grady_rad