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
29 if (iv % num_ssmt1 < 1) return
30
31 if (trace_use) call da_trace_entry("da_get_innov_vector_ssmt1")
32
33 itt = 0 ; ittf = 0
34 do n=1, iv % num_ssmt1
35
36 num_levs = iv % ssmt1(n) % info % levels
37
38 if (num_levs < 1) cycle
39
40 model_t(:) = 0.0
41
42 ! [1.1] Get horizontal interpolation weights:
43
44 i = iv%ssmt1(n)%loc%i
45 j = iv%ssmt1(n)%loc%j
46 dx = iv%ssmt1(n)%loc%dx
47 dy = iv%ssmt1(n)%loc%dy
48 dxm = iv%ssmt1(n)%loc%dxm
49 dym = iv%ssmt1(n)%loc%dym
50
51 do k=xp%kts,xp%kte
52 v_h(k) = dym*(dxm*xb%h(i,j ,k) + dx*xb%h(i+1,j ,k)) &
53 + dy *(dxm*xb%h(i,j+1,k) + dx*xb%h(i+1,j+1,k))
54 v_p(k) = dym*(dxm*xb%p(i,j ,k) + dx*xb%p(i+1,j ,k)) &
55 + dy *(dxm*xb%p(i,j+1,k) + dx*xb%p(i+1,j+1,k))
56 end do
57
58 num_levs=0
59 do k=1, iv % ssmt1(n) % info % levels
60
61 zk=missing_r
62
63 if (iv % ssmt1(n) % h(k) > 0.0) then
64 call da_to_zk(iv % ssmt1(n) % h(k), v_h, xp, v_interp_h, zk)
65 else if (iv % ssmt1(n) % p(k) > 1.0) then
66 call da_to_zk(iv % ssmt1(n) % p(k), v_p, xp, v_interp_p, zk)
67 end if
68
69 if (zk > 0.0) then
70 num_levs=num_levs+1
71 iv%ssmt1(n)%zk(num_levs)=zk
72
73 ob % ssmt1(n) % t(num_levs) = ob % ssmt1(n) % t(k)
74
75 iv % ssmt1(n) % t(num_levs) % qc = iv % ssmt1(n) % t(k) % qc
76
77 iv % ssmt1(n) % t(num_levs) % error = iv % ssmt1(n) % t(k) % error
78 end if
79 end do
80
81 iv % ssmt1(n) % info % levels = num_levs
82
83 ! [1.2] Interpolate horizontally to ob:
84
85 call da_interp_lin_3d( xb % t, xp, i, j, dx, dy, dxm, dym, &
86 model_t, max_ob_levels, iv%ssmt1(n)%zk, num_levs)
87
88 !---------------------------------------------------------------------
89 ! [2.0] Initialise components of innovation vector:
90 !---------------------------------------------------------------------
91
92 do k = 1, iv % ssmt1(n) % info % levels
93
94 iv % ssmt1(n) % t(k) % inv = 0.0
95
96 !----------------------------------------------------------------
97 ! [3.0] Interpolation:
98 !----------------------------------------------------------------
99
100 if (ob % ssmt1(n) % t(k) > missing_r .AND. &
101 iv % ssmt1(n) % t(k) % qc >= obs_qc_pointer) then
102
103 iv % ssmt1(n) % t(k) % inv = ob % ssmt1(n) % t(k) - &
104 model_t(k)
105 end if
106 end do
107
108 !------------------------------------------------------------------
109 ! [5.0] Perform optional maximum error check:
110 !------------------------------------------------------------------
111
112 if (check_max_iv) call da_check_max_iv_ssmt1(it,iv%ssmt1(n),itt,ittf)
113 end do
114
115 if (rootproc .and. check_max_iv_print) then
116 write(unit = check_max_iv_unit, fmt ='(A,i5,A)') &
117 'For outer iteration ',it,' Total Rejections for SSMI(T1) follows:'
118 write(unit = check_max_iv_unit, fmt = '(/,2(2(A,I6),/))') &
119 'Number of failed RH(T1) observations: ',ittf, ' on ',itt
120 end if
121
122 if (trace_use) call da_trace_exit("da_get_innov_vector_ssmt1")
123
124 end subroutine da_get_innov_vector_ssmt1
125
126