da_get_innov_vector_ssmt1.inc
References to this file elsewhere.
1 subroutine da_get_innov_vector_ssmt1( it, xb, xp, ob, iv)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: it ! External iteration.
10 type(xb_type), intent(in) :: xb ! first guess state.
11 type(xpose_type), intent(in) :: xp ! Domain decomposition vars.
12 type(y_type), intent(inout) :: ob ! Observation structure.
13 type(ob_type), intent(inout) :: iv ! O-B structure.
14
15 integer :: n ! Loop counter.
16 integer :: i, j, k ! Index dimension.
17 integer :: num_levs ! Number of obs levels.
18 real :: dx, dxm ! Interpolation weights.
19 real :: dy, dym ! Interpolation weights.
20 real, dimension(1:max_ob_levels) :: model_t ! Model value t at ob location.
21
22 real :: zk ! Interpolation vertical coordinator.
23
24 real, dimension(xp%kms:xp%kme) :: v_h ! Model value h at ob hor. location.
25 real, dimension(xp%kms:xp%kme) :: v_p ! Model value p at ob hor. location.
26
27 integer :: itt, ittf
28 if (iv % num_ssmt1 > 0) then
29 itt = 0 ; ittf = 0
30 do n=1, iv % num_ssmt1
31
32 num_levs = iv % ssmt1(n) % info % levels
33
34 if (num_levs < 1) cycle
35
36 model_t(:) = 0.0
37
38 ! [1.1] Get horizontal interpolation weights:
39
40 i = iv%ssmt1(n)%loc%i
41 j = iv%ssmt1(n)%loc%j
42 dx = iv%ssmt1(n)%loc%dx
43 dy = iv%ssmt1(n)%loc%dy
44 dxm = iv%ssmt1(n)%loc%dxm
45 dym = iv%ssmt1(n)%loc%dym
46
47 do k=xp%kts,xp%kte
48 v_h(k) = dym*(dxm*xb%h(i,j ,k) + dx*xb%h(i+1,j ,k)) &
49 + dy *(dxm*xb%h(i,j+1,k) + dx*xb%h(i+1,j+1,k))
50 v_p(k) = dym*(dxm*xb%p(i,j ,k) + dx*xb%p(i+1,j ,k)) &
51 + dy *(dxm*xb%p(i,j+1,k) + dx*xb%p(i+1,j+1,k))
52 end do
53
54 num_levs=0
55 do k=1, iv % ssmt1(n) % info % levels
56
57 zk=missing_r
58
59 if (iv % ssmt1(n) % h(k) > 0.0) then
60 call da_to_zk(iv % ssmt1(n) % h(k), v_h, xp, v_interp_h, zk)
61 else if (iv % ssmt1(n) % p(k) > 1.0) then
62 call da_to_zk(iv % ssmt1(n) % p(k), v_p, xp, v_interp_p, zk)
63 end if
64
65 if (zk > 0.0) then
66 num_levs=num_levs+1
67 iv%ssmt1(n)%zk(num_levs)=zk
68
69 ob % ssmt1(n) % t(num_levs) = ob % ssmt1(n) % t(k)
70
71 iv % ssmt1(n) % t(num_levs) % qc = iv % ssmt1(n) % t(k) % qc
72
73 iv % ssmt1(n) % t(num_levs) % error = iv % ssmt1(n) % t(k) % error
74 end if
75 end do
76
77 iv % ssmt1(n) % info % levels = num_levs
78
79 ! [1.2] Interpolate horizontally to ob:
80
81 call da_interp_lin_3d( xb % t, xp, i, j, dx, dy, dxm, dym, &
82 model_t, max_ob_levels, iv%ssmt1(n)%zk, num_levs)
83
84 !---------------------------------------------------------------------
85 ! [2.0] Initialise components of innovation vector:
86 !---------------------------------------------------------------------
87
88 do k = 1, iv % ssmt1(n) % info % levels
89
90 iv % ssmt1(n) % t(k) % inv = 0.0
91
92 !----------------------------------------------------------------
93 ! [3.0] Interpolation:
94 !----------------------------------------------------------------
95
96 if (ob % ssmt1(n) % t(k) > missing_r .AND. &
97 iv % ssmt1(n) % t(k) % qc >= obs_qc_pointer) then
98
99 iv % ssmt1(n) % t(k) % inv = ob % ssmt1(n) % t(k) - &
100 model_t(k)
101 end if
102 end do
103
104 !------------------------------------------------------------------
105 ! [5.0] Perform optional maximum error check:
106 !------------------------------------------------------------------
107
108 if (check_max_iv) call da_check_max_iv_ssmt1(it,iv%ssmt1(n),itt,ittf)
109 end do
110
111 if (rootproc .and. check_max_iv_print) then
112 write(unit = check_max_iv_unit, fmt ='(A,i5,A)') &
113 'For outer iteration ',it,' Total Rejections for SSMI(T1) follows:'
114 write(unit = check_max_iv_unit, fmt = '(/,2(2(A,I6),/))') &
115 'Number of failed RH(T1) observations: ',ittf, ' on ',itt
116 end if
117 end if
118
119 end subroutine da_get_innov_vector_ssmt1
120
121