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