da_transform_xtopsfc.inc
References to this file elsewhere.
1 subroutine da_transform_xtopsfc(grid, iv, obs_index, synop, y_synop)
2
3 !---------------------------------------------------------------------
4 ! Purpose: TBD
5 !---------------------------------------------------------------------
6
7 implicit none
8
9 type (domain), intent(in) :: grid
10 type (iv_type), intent(in) :: iv
11 integer, intent(in) :: obs_index
12 type (synop_type), intent(in) :: synop(:)
13 type (residual_synop_type), intent(out) :: y_synop(:)
14
15 integer :: n
16 real :: to, qo
17 real, allocatable :: hsm(:,:)
18 real, allocatable :: tsm(:,:)
19 real, allocatable :: qsm(:,:)
20 real, allocatable :: psm(:,:)
21 real, allocatable :: psm_prime(:,:)
22 real, allocatable :: u(:,:)
23 real, allocatable :: v(:,:)
24 real, allocatable :: t(:,:)
25 real, allocatable :: q(:,:)
26
27 if (trace_use) call da_trace_entry("da_transform_xtopsfc")
28
29 allocate (hsm(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
30 allocate (tsm(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
31 allocate (qsm(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
32 allocate (psm(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
33 allocate (psm_prime(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
34 allocate (u(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
35 allocate (v(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
36 allocate (t(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
37 allocate (q(1,iv%info(obs_index)%n1:iv%info(obs_index)%n2))
38
39 ! 2.0 Surface assmiilation approach 2 (2-m t and q, 10-m u and v)
40
41 call da_interp_lin_2d(grid%xa%u10, iv%info(obs_index), 1, u)
42 call da_interp_lin_2d(grid%xa%v10, iv%info(obs_index), 1, v)
43 call da_interp_lin_2d(grid%xa%psfc, iv%info(obs_index), 1, psm_prime)
44 call da_interp_lin_2d(grid%xa%t2, iv%info(obs_index), 1, t)
45 call da_interp_lin_2d(grid%xa%q2, iv%info(obs_index), 1, q)
46 do n=iv%info(obs_index)%n1,iv%info(obs_index)%n2
47 y_synop(n)%u=u(1,n)
48 y_synop(n)%v=v(1,n)
49 y_synop(n)%t=t(1,n)
50 y_synop(n)%q=q(1,n)
51 end do
52
53 ! 3.2 model background surface p, t, q, h at observed site:
54
55 call da_interp_lin_2d(grid%xb%terr, iv%info(obs_index), 1, hsm)
56 call da_interp_lin_2d(grid%xb%t2, iv%info(obs_index), 1, tsm)
57 call da_interp_lin_2d(grid%xb%q2, iv%info(obs_index), 1, qsm)
58 call da_interp_lin_2d(grid%xb%psfc, iv%info(obs_index), 1, psm)
59
60 do n=iv%info(obs_index)%n1,iv%info(obs_index)%n2
61 if (synop(n)%p%qc < 0) then
62 y_synop(n)%p = 0.0
63 else
64
65 ! 3.0 The pressure at the observed height:
66
67 ! 3.1 Constants:
68
69 to = -888888.0
70 qo = -888888.0
71
72 ! Terrain height at the observed site:
73
74 ! 3.3 perturbations t, q, p at the model surface:
75
76 ! 4.0 Compute the perturbation of the surface pressure perturbation
77 ! at the observed height
78
79 if (synop(n)%t%qc >= 0 .and. synop(n)%q%qc >= 0) then
80 ! 4.1 Observed value = background + innovation: both t, q available:
81 ! ----------------------------------------
82
83 to = tsm(1,n) + synop(n)%t%inv
84 qo = qsm(1,n) + synop(n)%q%inv
85 call da_sfc_pre_lin(y_synop(n)%p, psm_prime(1,n), y_synop(n)%t, y_synop(n)%q, &
86 psm(1,n), tsm(1,n), qsm(1,n), hsm(1,n), synop(n)%h, to, qo)
87 else if (synop(n)%t%qc >= 0 .and. synop(n)%q%qc < 0) then
88
89 ! 4.2 Observed value = background + innovation: only t available
90 ! ----------------------------------------
91
92 to = tsm(1,n) + synop(n)%t%inv
93 call da_sfc_pre_lin(y_synop(n)%p, psm_prime(1,n), y_synop(n)%t, y_synop(n)%q, &
94 psm(1,n), tsm(1,n), qsm(1,n), hsm(1,n), synop(n)%h, to)
95 else
96 ! 4.3 No observed t and q available:
97 ! -----------------------------
98
99 call da_sfc_pre_lin(y_synop(n)%p, psm_prime(1,n), y_synop(n)%t, y_synop(n)%q, &
100 psm(1,n), tsm(1,n), qsm(1,n), hsm(1,n), synop(n)%h)
101 end if
102 end if
103 end do
104
105 deallocate (hsm)
106 deallocate (tsm)
107 deallocate (qsm)
108 deallocate (psm)
109 deallocate (psm_prime)
110 deallocate (u)
111 deallocate (v)
112 deallocate (t)
113 deallocate (q)
114
115 if (trace_use) call da_trace_exit("da_transform_xtopsfc")
116
117 end subroutine da_transform_xtopsfc
118
119