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