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