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
24 ! Computation to check for edge of domain:
25
26 is = its
27 ie = ite
28 js = jts
29 je = jte
30 if (its == ids) is = ids+1
31 if (ite == ide) ie = ide-1
32 if (jts == jds) js = jds+1
33 if (jte == jde) je = jde-1
34
35
36 do K=kts,kte
37 do J=js,je
38 do I=is,ie
39 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)
40 end do
41 end do
42
43 do J=js,je
44 do I=is,ie
45 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)
46 end do
47 end do
48 end do
49
50 if (its == ids) then
51 i = its
52 do K=kts,kte
53 do J=js,je
54 WZ_b(I,J,K)=WZ_b(I+1,J,K)
55 end do
56 end do
57 end if
58
59 if (ite == ide) then
60 i = ite
61 do K=kts,kte
62 do J=js,je
63 WZ_b(I,J,K)=WZ_b(I-1,J,K)
64 end do
65 end do
66 end if
67
68 if (jts == jds) then
69 j = jts
70 do K=kts,kte
71 do I=its, ite
72 WZ_b(I,J,K)=WZ_b(I,J+1,K)
73 end do
74 end do
75 end if
76
77 if (jte == jde) then
78 j = jte
79 do K=kts,kte
80 do I=its, ite
81 WZ_b(I,J,K)=WZ_b(I,J-1,K)
82 end do
83 end do
84 end if
85
86
87 call da_uv_to_divergence(xb, xb%u,xb%v, DIV)
88
89 do K=kts,kte
90 do J=jts,jte
91 do I=its,ite
92 WZ_b(I,J,K)=WZ_b(I,J,K)-GAMMA*xb%p(I,J,K)*DIV(I,J,K)
93 end do
94 end do
95 end do
96
97
98 ! Computation to check for edge of domain:
99 is = its-1; ie = ite+1; js = jts-1; je = jte+1
100 if (its == ids) is = ids; if (ite == ide) ie = ide
101 if (jts == jds) js = jds; if (jte == jde) je = jde
102
103 do K=kts,kte
104 do J=js,je
105 do I=is,ie
106 URHO(I,J,K)=xb%rho(I,J,K)*xb%u(I,J,K)
107 VRHO(I,J,K)=xb%rho(I,J,K)*xb%v(I,J,K)
108 end do
109 end do
110 end do
111
112 call da_uv_to_divergence(xb, URHO, VRHO, DIV)
113
114 do J=jts,jte
115 do I=its,ite
116 TERM3=0.
117
118 do K=kte-1,kts,-1
119 TERM3=TERM3+GRAVITY*(DIV(I,J,K+1)+DIV(I,J,K))*0.5 &
120 *(xb%h(I,J,K+1)-xb%h(I,J,K))
121 WZ_b(I,J,K)=WZ_b(I,J,K)+TERM3
122 end do
123 end do
124 end do
125
126
127 do K=kts,kte
128 do J=jts,jte
129 do I=its,ite
130 WZ_b(I,J,K)=WZ_b(I,J,K)/(GAMMA*xb%p(I,J,K))
131 end do
132 end do
133 end do
134
135 end subroutine da_wz_base
136
137