da_transform_xtoy_gpspw_adj.inc
References to this file elsewhere.
1 subroutine da_transform_xtoy_gpspw_adj(xb, oi, xp, jo_grad_y, jo_grad_x)
2
3 !----------------------------------------------------------------
4 ! Purpose: Calculate the difference in the elevation between model surface and GPS site
5 !----------------------------------------------------------------
6
7 implicit none
8
9 type (xb_type), intent(in) :: xb ! first guess state.
10 type (ob_type), intent(in) :: oi ! obs. inc vector (o-b).
11 type (xpose_type), intent(in) :: xp ! Domain decomposition vars.
12 type (y_type) , intent(in) :: jo_grad_y ! grad_y(jo)
13 type (x_type) , intent(inout) :: jo_grad_x ! grad_x(jo)
14
15 integer :: n ! Loop counter.
16 integer :: i, j ! Index dimension.
17 real :: dx, dxm !
18 real :: dy, dym !
19
20 integer :: k ! Index dimension.
21 real :: dpw,ddpw ! adjustment pw [mm]
22 real :: obs_terr ! real terrain height at GPS site [m]
23 real :: model_terr ! model terrain height at GPS site[m]
24 real,dimension(xp%kts:xp%kte):: model_q ! model q at GPS site [kg/kg]
25 real,dimension(xp%kts:xp%kte):: model_z ! model z at GPS site [m]
26 real,dimension(xp%kts:xp%kte):: model_rho ! model rho at GPS site [kg/m^3]
27 real,dimension(xp%kts:xp%kte):: model_dq ! model dq at GPS site [kg/kg]
28 real,dimension(xp%kts:xp%kte):: model_drho ! model drho at GPS site [kg/m^3]
29
30 if (oi%num_Gpspw > 0) then
31 do n=oi%ob_numb(oi%current_ob_time-1)%gpspw + 1, oi%ob_numb(oi%current_ob_time)%gpspw
32 i = oi%gpspw(n)%loc%i
33 dy = oi%gpspw(n)%loc%dy
34 dym = oi%gpspw(n)%loc%dym
35 j = oi%gpspw(n)%loc%j
36 dx = oi%gpspw(n)%loc%dx
37 dxm = oi%gpspw(n)%loc%dxm
38
39 ! Initialise the varibles
40 dpw = 0.
41 model_q(:) = 0.
42 model_dq(:) = 0.
43 model_rho(:) = 0.
44 model_drho(:) = 0.
45
46 obs_terr = oi%gpspw(n)%info%elv
47 model_terr = dym*(dxm*xb%terr(i,j) + dx*xb%terr(i+1,j)) + &
48 dy *(dxm*xb%terr(i,j+1) + dx*xb%terr(i+1,j+1))
49
50 dpw = 0.1 *jo_grad_y%gpspw(n)%tpw
51
52 jo_grad_x%tpw(i ,j ) = jo_grad_x%tpw(i ,j ) &
53 + dxm*dym*jo_grad_y%gpspw(n)%tpw
54 jo_grad_x%tpw(i+1,j ) = jo_grad_x%tpw(i+1,j ) &
55 + dym*dx *jo_grad_y%gpspw(n)%tpw
56 jo_grad_x%tpw(i ,j+1) = jo_grad_x%tpw(i ,j+1) &
57 + dxm *dy*jo_grad_y%gpspw(n)%tpw
58 jo_grad_x%tpw(i+1,j+1) = jo_grad_x%tpw(i+1,j+1) &
59 + dx *dy *jo_grad_y%gpspw(n)%tpw
60
61 if (obs_terr <= model_terr) then
62 model_q(1) = dym*(dxm*xb%q(i,j,1) + dx*xb%q(i+1,j,1)) + &
63 dy *(dxm*xb%q(i,j+1,1) + dx*xb%q(i+1,j+1,1))
64 model_rho(1) = dym*(dxm*xb%rho(i,j,1) + dx*xb%rho(i+1,j,1)) + &
65 dy *(dxm*xb%rho(i,j+1,1) + dx*xb%rho(i+1,j+1,1))
66
67 model_dq(1) = model_rho(1)*(obs_terr - model_terr)*dpw
68 model_drho(1) = model_q(1) *(obs_terr - model_terr)*dpw
69
70 jo_grad_x%q(i,j,1) = jo_grad_x%q(i,j,1) + dym*dxm*model_dq(1)
71 jo_grad_x%q(i+1,j,1) = jo_grad_x%q(i+1,j,1) + dym*dx*model_dq(1)
72 jo_grad_x%q(i,j+1,1) = jo_grad_x%q(i,j+1,1) + dy*dxm*model_dq(1)
73 jo_grad_x%q(i+1,j+1,1) = jo_grad_x%q(i+1,j+1,1) + dy*dx*model_dq(1)
74
75 jo_grad_x%rho(i,j,1) = jo_grad_x%rho(i,j,1) + dym*dxm*model_drho(1)
76 jo_grad_x%rho(i+1,j,1) = jo_grad_x%rho(i+1,j,1) + dym*dx*model_drho(1)
77 jo_grad_x%rho(i,j+1,1) = jo_grad_x%rho(i,j+1,1) + dy*dxm*model_drho(1)
78 jo_grad_x%rho(i+1,j+1,1) = jo_grad_x%rho(i+1,j+1,1) + dy*dx*model_drho(1)
79 else
80 model_z(1) = dym*(dxm*xb%hf(i,j,1) + dx*xb%hf(i+1,j,1)) + &
81 dy *(dxm*xb%hf(i,j+1,1) + dx*xb%hf(i+1,j+1,1))
82
83 do k = xp%kts, xp%kte
84 if (model_z(k) >= obs_terr) exit
85
86 model_z(k+1) = dym*(dxm*xb%hf(i,j,k+1) + dx*xb%hf(i+1,j,k+1)) + &
87 dy *(dxm*xb%hf(i,j+1,k+1) + dx*xb%hf(i+1,j+1,k+1))
88 model_q(k) = dym*(dxm*xb%q(i,j,k) + dx*xb%q(i+1,j,k)) + &
89 dy *(dxm*xb%q(i,j+1,k) + dx*xb%q(i+1,j+1,k))
90 model_rho(k) = dym*(dxm*xb%rho(i,j,k) + dx*xb%rho(i+1,j,k)) + &
91 dy *(dxm*xb%rho(i,j+1,k) + dx*xb%rho(i+1,j+1,k))
92
93 ddpw = dpw
94
95 if (model_z(k+1) <= obs_terr) then
96 model_dq (k) = model_rho(k) *(model_z(k+1) - model_z(k))*ddpw
97 model_drho(k) = model_q(k) *(model_z(k+1) - model_z(k))*ddpw
98 else
99 model_dq (k) = model_rho(k) *(obs_terr-model_z(k))*ddpw
100 model_drho(k) = model_q(k) *(obs_terr-model_z(k))*ddpw
101 end if
102
103 ! No feedback to x%hf was considered here (Refer to comments in
104 ! da_transform_xtoy_gpspw.inc). Y.-R. Guo 07/15/2002
105 !.........................................................................
106
107 jo_grad_x%q(i,j,k) = jo_grad_x%q(i,j,k) + dym*dxm*model_dq(k)
108 jo_grad_x%q(i+1,j,k) = jo_grad_x%q(i+1,j,k) + dym*dx*model_dq(k)
109 jo_grad_x%q(i,j+1,k) = jo_grad_x%q(i,j+1,k) + dy*dxm*model_dq(k)
110 jo_grad_x%q(i+1,j+1,k) = jo_grad_x%q(i+1,j+1,k) + dy*dx*model_dq(k)
111
112 jo_grad_x%rho(i,j,k) = jo_grad_x%rho(i,j,k) + dym*dxm*model_drho(k)
113 jo_grad_x%rho(i+1,j,k) = jo_grad_x%rho(i+1,j,k) + dym*dx*model_drho(k)
114 jo_grad_x%rho(i,j+1,k) = jo_grad_x%rho(i,j+1,k) + dy*dxm*model_drho(k)
115 jo_grad_x%rho(i+1,j+1,k) = jo_grad_x%rho(i+1,j+1,k) + dy*dx*model_drho(k)
116 end do
117 end if
118 end do
119 end if
120
121 end subroutine da_transform_xtoy_gpspw_adj
122
123