da_to_zk.inc
References to this file elsewhere.
1 subroutine da_to_zk(obs_v, mdl_v, v_interp_optn, zk)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: v_interp_optn
10 real, intent(in) :: obs_v
11 real, dimension(kms:kme), intent(in) :: mdl_v
12 real, intent(out) :: zk
13
14 integer :: k
15
16 if (trace_use_dull) call da_trace_entry("da_to_zk")
17
18 zk = missing_r
19
20 if (v_interp_optn == v_interp_p) then
21 if (obs_v > mdl_v(kts) .or. obs_v < mdl_v(kte)) then
22 if (anal_type_verify) then
23 ! Guo (02/06/2006), for VERifY, allow the extrapolation to obtain the zk:
24 if (obs_v > mdl_v(kts)) then
25 ! below the lowest level:
26 zk = real(kts+1) - &
27 (obs_v-mdl_v(kts+1))/(mdl_v(kts)-mdl_v(kts+1))
28 else if (obs_v < mdl_v(kte)) then
29 ! above the highest level:
30 zk = real(kte-1) + &
31 (obs_v-mdl_v(kte-1))/(mdl_v(kte)-mdl_v(kte-1))
32 end if
33 else
34 if (trace_use_dull) call da_trace_exit("da_to_zk")
35 return
36 end if
37 else
38 do k = kts,kte-1
39 if(obs_v <= mdl_v(k) .and. obs_v >= mdl_v(k+1)) then
40 zk = real(k) + (mdl_v(k) - obs_v)/(mdl_v(k) - mdl_v(k+1))
41 exit
42 end if
43 end do
44 end if
45 else if(v_interp_optn == v_interp_h) then
46 if (obs_v < mdl_v(kts) .or. obs_v > mdl_v(kte)) then
47 if (anal_type_verify) then
48 ! Guo (02/06/2006), for VERifY, allow the extrapolation to obtain the zk:
49 if (obs_v < mdl_v(kts)) then
50 ! below the lowest level:
51 zk = real(kts+1) - &
52 (obs_v-mdl_v(kts+1))/(mdl_v(kts)-mdl_v(kts+1))
53 else if (obs_v > mdl_v(kte)) then
54 ! above the highest level:
55 zk = real(kte-1) + &
56 (obs_v-mdl_v(kte-1))/(mdl_v(kte)-mdl_v(kte-1))
57 end if
58 else
59 if (trace_use_dull) call da_trace_exit("da_to_zk")
60 return
61 end if
62 else
63 do k = kts,kte-1
64 if(obs_v >= mdl_v(k) .and. obs_v <= mdl_v(k+1)) then
65 zk = real(k) + (mdl_v(k) - obs_v)/(mdl_v(k) - mdl_v(k+1))
66 exit
67 end if
68 end do
69 end if
70 end if
71
72 if (trace_use_dull) call da_trace_exit("da_to_zk")
73
74 end subroutine da_to_zk
75
76