da_wz_base.inc
References to this file elsewhere.
1 subroutine da_wz_base(xb,WZ_b)
2
3 !--------------------------------------------------------------------
4 ! Purpose: TBD
5 !--------------------------------------------------------------------
6
7 implicit none
8
9 type (xb_type), intent(in) :: xb ! First guess structure.
10
11 real, dimension(ims:ime,jms:jme,kms:kme), intent(inout) :: WZ_b
12
13 integer :: is, ie ! 1st dim. end points.
14 integer :: js, je ! 2nd dim. end points.
15
16 integer :: I,J,K
17
18 real :: TERM3
19
20 real, dimension(ims:ime,jms:jme,kms:kme) :: URHO, VRHO
21 real, dimension(ims:ime,jms:jme,kms:kme) :: DIV
22
23 if (trace_use) call da_trace_entry("da_wz_base")
24
25
26 ! Computation to check for edge of domain:
27
28 is = its
29 ie = ite
30 js = jts
31 je = jte
32 if (its == ids) is = ids+1
33 if (ite == ide) ie = ide-1
34 if (jts == jds) js = jds+1
35 if (jte == jde) je = jde-1
36
37
38 do K=kts,kte
39 do J=js,je
40 do I=is,ie
41 WZ_b(I,J,K)=-xb%u(I,J,K)*(xb%p(I+1,J,K)-xb%p(I-1,J,K))*xb%coefx(I,J)
42 end do
43 end do
44
45 do J=js,je
46 do I=is,ie
47 WZ_b(I,J,K)=WZ_b(I,J,K)-xb%v(I,J,K)*(xb%p(I,J+1,K)-xb%p(I,J-1,K))*xb%coefy(I,J)
48 end do
49 end do
50 end do
51
52 if (its == ids) then
53 i = its
54 do K=kts,kte
55 do J=js,je
56 WZ_b(I,J,K)=WZ_b(I+1,J,K)
57 end do
58 end do
59 end if
60
61 if (ite == ide) then
62 i = ite
63 do K=kts,kte
64 do J=js,je
65 WZ_b(I,J,K)=WZ_b(I-1,J,K)
66 end do
67 end do
68 end if
69
70 if (jts == jds) then
71 j = jts
72 do K=kts,kte
73 do I=its, ite
74 WZ_b(I,J,K)=WZ_b(I,J+1,K)
75 end do
76 end do
77 end if
78
79 if (jte == jde) then
80 j = jte
81 do K=kts,kte
82 do I=its, ite
83 WZ_b(I,J,K)=WZ_b(I,J-1,K)
84 end do
85 end do
86 end if
87
88
89 call da_uv_to_divergence(xb, xb%u,xb%v, DIV)
90
91 do K=kts,kte
92 do J=jts,jte
93 do I=its,ite
94 WZ_b(I,J,K)=WZ_b(I,J,K)-GAMMA*xb%p(I,J,K)*DIV(I,J,K)
95 end do
96 end do
97 end do
98
99
100 ! Computation to check for edge of domain:
101 is = its-1; ie = ite+1; js = jts-1; je = jte+1
102 if (its == ids) is = ids; if (ite == ide) ie = ide
103 if (jts == jds) js = jds; if (jte == jde) je = jde
104
105 do K=kts,kte
106 do J=js,je
107 do I=is,ie
108 URHO(I,J,K)=xb%rho(I,J,K)*xb%u(I,J,K)
109 VRHO(I,J,K)=xb%rho(I,J,K)*xb%v(I,J,K)
110 end do
111 end do
112 end do
113
114 call da_uv_to_divergence(xb, URHO, VRHO, DIV)
115
116 do J=jts,jte
117 do I=its,ite
118 TERM3=0.
119
120 do K=kte-1,kts,-1
121 TERM3=TERM3+GRAVITY*(DIV(I,J,K+1)+DIV(I,J,K))*0.5 &
122 *(xb%h(I,J,K+1)-xb%h(I,J,K))
123 WZ_b(I,J,K)=WZ_b(I,J,K)+TERM3
124 end do
125 end do
126 end do
127
128
129 do K=kts,kte
130 do J=jts,jte
131 do I=its,ite
132 WZ_b(I,J,K)=WZ_b(I,J,K)/(GAMMA*xb%p(I,J,K))
133 end do
134 end do
135 end do
136
137 if (trace_use) call da_trace_exit("da_wz_base")
138
139 end subroutine da_wz_base
140
141