da_setup_pseudo_obs.inc
References to this file elsewhere.
1 subroutine da_setup_pseudo_obs(xp, iv, ob)
2
3 !-------------------------------------------------------------------------
4 ! Purpose: Sets up pseudo ob part of observation structure.
5 !-------------------------------------------------------------------------
6
7 implicit none
8
9 type (ob_type), intent(inout) :: iv ! Obs and header structure.
10 type (y_type), intent(inout) :: ob ! (Smaller) observation structure.
11 type(xpose_type), intent(in) :: xp ! Domain decomposition vars.
12
13 logical :: outside !wrt local domain
14 integer :: i, j ! local variables
15 integer :: n ! Loop counters.
16
17 if (trace_use) call da_trace_entry("da_setup_pseudo_obs")
18
19 outside = .false.
20 i = int(pseudo_x)
21 j = int(pseudo_Y)
22
23 if (fg_format == fg_format_kma_global) then
24 if ((j < xp%jts-1) .or. (j > xp%jte)) outside = .true.
25 else
26
27 if ((i < xp%ids) .or. (i >= xp%ide) .or. &
28 (j < xp%jds) .or. (j >= xp%jde)) outside = .true.
29
30 if ((i < xp%its-1) .or. (i > xp%ite) .or. &
31 (j < xp%jts-1) .or. (j > xp%jte)) outside = .true.
32 end if
33
34 if (outside) then
35 iv%num_pseudo = 0
36 iv%ob_numb(iv%current_ob_time)%pseudo = 0
37 return
38 else
39 iv % num_pseudo = num_pseudo
40 ob % num_pseudo = num_pseudo
41 iv%num_pseudo_glo = num_pseudo
42 iv%ob_numb(iv%current_ob_time)%pseudo = iv%num_pseudo
43 end if
44
45 allocate (iv % pseudo(1:ob % num_pseudo))
46
47 do n=1, iv % num_pseudo
48
49 iv % pseudo(n) % u % inv = missing_r
50 iv % pseudo(n) % v % inv = missing_r
51 iv % pseudo(n) % t % inv = missing_r
52 iv % pseudo(n) % p % inv = missing_r
53 iv % pseudo(n) % q % inv = missing_r
54
55 iv % pseudo(n) % u % error = missing_r
56 iv % pseudo(n) % v % error = missing_r
57 iv % pseudo(n) % t % error = missing_r
58 iv % pseudo(n) % p % error = missing_r
59 iv % pseudo(n) % q % error = missing_r
60
61 iv % pseudo(n) % u % qc = missing_data
62 iv % pseudo(n) % v % qc = missing_data
63 iv % pseudo(n) % t % qc = missing_data
64 iv % pseudo(n) % p % qc = missing_data
65 iv % pseudo(n) % q % qc = missing_data
66
67 ob % pseudo(n) % u = missing_r
68 ob % pseudo(n) % v = missing_r
69 ob % pseudo(n) % t = missing_r
70 ob % pseudo(n) % p = missing_r
71 ob % pseudo(n) % q = missing_r
72
73 !---------------------------------------------------------------
74 ! [1.0] Initialise components of innovation vector:
75 !---------------------------------------------------------------
76
77 iv % pseudo(n)%loc%x = pseudo_x
78 iv % pseudo(n)%loc%y = pseudo_y
79 iv % pseudo(n)%zk = pseudo_z
80
81 iv%pseudo(n)%loc%i = int(pseudo_x)
82 iv%pseudo(n)%loc%j = int(pseudo_y)
83
84 iv%pseudo(n)%loc%dx = pseudo_x-real(iv%pseudo(n)%loc%i)
85 iv%pseudo(n)%loc%dy = pseudo_y-real(iv%pseudo(n)%loc%j)
86 iv%pseudo(n)%loc%dxm=1.0-iv%pseudo(n)%loc%dx
87 iv%pseudo(n)%loc%dym=1.0-iv%pseudo(n)%loc%dy
88
89 if (pseudo_var(1:1) == 'u' .or. pseudo_var(1:1) == 'U') then
90 iv % pseudo(n) % u % inv = pseudo_val
91 iv % pseudo(n) % u % error = pseudo_err
92 iv % pseudo(n) % u % qc = 0
93 else if (pseudo_var(1:1) == 'v' .or. pseudo_var(1:1) == 'V') then
94 iv % pseudo(n) % v % inv = pseudo_val
95 iv % pseudo(n) % v % error = pseudo_err
96 iv % pseudo(n) % v % qc = 0
97 else if (pseudo_var(1:1) == 't' .or. pseudo_var(1:1) == 'T') then
98 iv % pseudo(n) % t % inv = pseudo_val
99 iv % pseudo(n) % t % error = pseudo_err
100 iv % pseudo(n) % t % qc = 0
101 else if (pseudo_var(1:1) == 'p' .or. pseudo_var(1:1) == 'P') then
102 iv % pseudo(n) % p % inv = pseudo_val
103 iv % pseudo(n) % p % error = pseudo_err
104 iv % pseudo(n) % p % qc = 0
105 else if (pseudo_var(1:1) == 'q' .or. pseudo_var(1:1) == 'Q') then
106 iv % pseudo(n) % q % inv = pseudo_val
107 iv % pseudo(n) % q % error = pseudo_err
108 iv % pseudo(n) % q % qc = 0
109 end if
110
111 write(unit=stdout,fmt='(a4,2f15.5)')pseudo_var, pseudo_val, pseudo_err
112 write(unit=stdout,fmt='(3f15.5)')pseudo_x, pseudo_y, pseudo_z
113 end do
114
115 if (trace_use) call da_trace_exit("da_setup_pseudo_obs")
116
117 end subroutine da_setup_pseudo_obs
118
119