da_transform_xtotb_adj.inc
References to this file elsewhere.
1 subroutine da_transform_xtotb_adj (grid)
2
3 !----------------------------------------------------------------------
4 ! Purpose: TBD
5 !----------------------------------------------------------------------
6
7 implicit none
8
9 type (domain), intent(inout) :: grid
10
11 integer :: i,j,k
12 integer :: is, js, ie, je
13
14 real :: dx, dy, dxm, dym, zhmkz
15 real :: dum1, dum2, zrhom, ADJ_zrhom
16
17 real :: psfc,ta,gamma,sst,htpw,speed,alw,zcld,tpw
18 real :: ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst,ADJ_tpw
19 real :: ADJ_htpw,ADJ_speed,ADJ_alw,ADJ_zcld
20
21 if (trace_use) call da_trace_entry("da_transform_xtotb_adj")
22
23 psfc = 0.0
24 ta = 0.0
25 gamma = 0.0
26 sst = 0.0
27 htpw = 0.0
28 speed = 0.0
29 alw = 0.0
30 zcld = 0.0
31 tpw = 0.0
32 dx = 0.0
33 dy = 0.0
34 dxm = 0.0
35 dym = 0.0
36 zhmkz = 0.0
37 dum1 = 0.0
38 dum2 = 0.0
39 zrhom = 0.0
40 ADJ_zrhom = 0.0
41
42 is = its
43 js = jts
44
45 ie = ite
46 je = jte
47
48 if (test_wrfvar) then
49 is = its-1
50 js = jts-1
51
52 ie = ite+1
53 je = jte+1
54
55 if (is < ids) is = ids
56 if (js < jds) js = jds
57
58 if (ie > ide) ie = ide
59 if (je > jde) je = jde
60 end if
61
62 ! Mean fields
63
64 do j=js, je
65 do i=is, ie
66 psfc = 0.01*grid%xb%psfc(i,j)
67 ! sst = grid%xb%tgrn(i,j)
68 ta = grid%xb%tgrn(i,j) + &
69 (grid%xb%t(i,j,kts)-grid%xb%tgrn(i,j))*log(2.0/0.0001)/ &
70 log((grid%xb%h(i,j,kts)- grid%xb%terr(i,j))/0.0001)
71
72 gamma = (ta-270.0)*0.023 + 5.03 ! effective lapse rate (km) (4.0-6.5)
73 zcld = 1 ! effective cloud height (km)
74
75 tpw = grid%xb%tpw(i,j)*10.0
76 ! speed = grid%xb%speed(i,j)
77
78 alw = 0.0
79
80 zrhom = 0.0
81 do k=kts,kte
82 zrhom=zrhom+(grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)*grid%xb%q(i,j,k)* &
83 grid%xb%rho(i,j,k)
84 end do
85
86 ! call da_transform_xtozrhoq(grid%xb, i, j, zh, zf, zrhom)
87
88 htpw = zrhom/tpw/1000.0
89
90 dum1=0.0
91 dum2=0.0
92
93 ADJ_gamma = 0.0
94 ADJ_speed = 0.0
95 ADJ_psfc = 0.0
96 ADJ_zcld = 0.0
97 ADJ_htpw = 0.0
98 ADJ_sst = 0.0
99 ADJ_alw = 0.0
100 ADJ_tpw = 0.0
101 ADJ_ta = 0.0
102 ADJ_zrhom = 0.0
103
104 call da_tb_adj(1,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw, &
105 htpw,grid%xb%speed(i,j),alw,zcld, &
106 ! grid%xb%tb19v(i,j),grid%xb%tb19h(i,j), &
107 ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst, &
108 ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw, &
109 ADJ_zcld,grid%xa%tb19v(i,j),grid%xa%tb19h(i,j) )
110
111 call da_tb_adj(2,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw, &
112 htpw,grid%xb%speed(i,j),alw,zcld, &
113 ! grid%xb%tb22v(i,j),dum1, &
114 ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst, &
115 ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw, &
116 ADJ_zcld,grid%xa%tb22v(i,j),dum2 )
117
118 call da_tb_adj(3,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw, &
119 htpw,grid%xb%speed(i,j),alw,zcld, &
120 ! grid%xb%tb37v(i,j),grid%xb%tb37h(i,j), &
121 ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst, &
122 ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw, &
123 ADJ_zcld,grid%xa%tb37v(i,j),grid%xa%tb37h(i,j) )
124
125 call da_tb_adj(4,53.0,psfc,ta,gamma,grid%xb%tgrn(i,j),tpw, &
126 htpw,grid%xb%speed(i,j),alw,zcld, &
127 ! grid%xb%tb85v(i,j),grid%xb%tb85h(i,j), &
128 ADJ_psfc,ADJ_ta,ADJ_gamma,ADJ_sst, &
129 ADJ_tpw,ADJ_htpw,ADJ_speed,ADJ_alw, &
130 ADJ_zcld,grid%xa%tb85v(i,j),grid%xa%tb85h(i,j) )
131
132 ADJ_zrhom = ADJ_htpw/tpw/1000.0
133 ADJ_tpw = ADJ_tpw - ADJ_htpw/tpw*htpw
134
135 do k = kts,kte
136 grid%xa%rho(i,j,k) = (grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)* &
137 grid%xb%q(i,j,k)*ADJ_zrhom + grid%xa%rho(i,j,k)
138 grid%xa%q(i,j,k) = (grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k))*grid%xb%h(i,j,k)* &
139 ADJ_zrhom*grid%xb%rho(i,j,k) + grid%xa%q(i,j,k)
140 end do
141
142 ! call da_transform_xtozrhoq_adj(grid%xb,grid%xa,i,j,zh,zf,ADJ_zrhom)
143
144 ADJ_alw = 0.0
145
146 grid%xa%speed(i,j)=grid%xa%speed(i,j) + ADJ_speed
147
148 grid%xa%tpw(i,j) = grid%xa%tpw(i,j) + ADJ_tpw*10.0
149
150 ADJ_zcld= 0
151 ADJ_ta = ADJ_ta + ADJ_gamma*0.023
152
153 grid%xa%t(i,j,kts) = grid%xa%t(i,j,kts) + ADJ_ta* &
154 log(2.0/0.0001)/log((grid%xb%h(i,j,kts)-grid%xb%terr(i,j))/0.0001)
155 ADJ_sst = 0.0
156
157 grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + ADJ_psfc*0.01
158 end do
159 end do
160
161 if (trace_use) call da_trace_exit("da_transform_xtotb_adj")
162
163 end subroutine da_transform_xtotb_adj
164
165