da_check_xtoy_adjoint_bogus.inc
References to this file elsewhere.
1 subroutine da_check_xtoy_adjoint_bogus(oi, y, adjtest_lhs, pertile_lhs)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 type (ob_type), intent(in) :: oi ! 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 :: n, k ! Loop counter.
14
15 if (oi%num_Bogus > 0) then
16
17 do n=1, oi%num_Bogus
18 if (oi%bogus(n)%loc%proc_domain) then
19 do k=1, oi%bogus(n)%info%levels
20 adjtest_lhs = adjtest_lhs + &
21 (y%Bogus(n)%u(k)/typical_u_rms)**2 + &
22 (y%Bogus(n)%v(k)/typical_v_rms)**2 + &
23 (y%Bogus(n)%t(k)/typical_t_rms)**2 + &
24 (y%Bogus(n)%q(k)/typical_q_rms)**2
25 end do
26 adjtest_lhs = adjtest_lhs + &
27 (y%Bogus(n)%slp/typical_p_rms)**2
28 end if
29
30 do k=1, oi%bogus(n)%info%levels
31 pertile_lhs = pertile_lhs + &
32 (y%bogus(n)%u(k)/typical_u_rms)**2 + &
33 (y%bogus(n)%v(k)/typical_v_rms)**2 + &
34 (y%bogus(n)%t(k)/typical_t_rms)**2 + &
35 (y%bogus(n)%q(k)/typical_q_rms)**2
36
37 y%bogus(n)%u(k) = y%bogus(n)%u(k) / typical_u_rms ** 2
38 y%bogus(n)%v(k) = y%bogus(n)%v(k) / typical_v_rms ** 2
39 y%bogus(n)%t(k) = y%bogus(n)%t(k) / typical_t_rms ** 2
40 y%bogus(n)%q(k) = y%bogus(n)%q(k) / typical_q_rms ** 2
41 end do
42 pertile_lhs = pertile_lhs + &
43 (y%bogus(n)%slp/typical_p_rms)**2
44 y%bogus(n)%slp = y%bogus(n)%slp / typical_p_rms ** 2
45 end do
46 end if
47
48 end subroutine da_check_xtoy_adjoint_bogus
49
50