File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\impadj_hyb.locl_gc.f
1 subroutine impadje_hyb_gc(de,te,qe,xe,ye,ze,
2 x dti,ue,ve,snnp1ev,ndexev,
3 x ls_node,locl)
4
5 use gfs_dyn_resol_def
6 use gfs_dyn_layout1
7 use gfs_dyn_coordinate_def
8 implicit none
9 real(kind=kind_evod) de(len_trie_ls,2,levs),te(len_trie_ls,2,levs)
10 real(kind=kind_evod) xe(len_trie_ls,2,levs),ye(len_trie_ls,2,levs)
11 real(kind=kind_evod) ue(len_trie_ls,2,levs),ve(len_trie_ls,2,levs)
12 real(kind=kind_evod) qe(len_trie_ls,2), ze(len_trie_ls,2)
13 real(kind=kind_evod) dti,dt
14 real(kind=kind_evod) snnp1ev(len_trie_ls)
15 integer ndexev(len_trie_ls)
16 integer j,k
17 integer ls_node(ls_dim,3)
18 integer indev,indev1,indev2,l,locl,n
19 integer indlsev,jbasev
20 integer indlsod,jbasod
21 include 'function2'
22 real(kind=kind_evod) cons0
23
24
25
26
27 =dti*(1.+eps_si)
28
29 cons0 = 0.d0
30 = ls_node(locl,1)
31 jbasev = ls_node(locl,2)
32 indev1 = indlsev(L,L)
33 if (mod(L,2).eq.mod(jcap+1,2)) then
34 indev2 = indlsev(jcap+1,L)
35 else
36 indev2 = indlsev(jcap ,L)
37 endif
38 do k=1,levs
39
40 do indev = indev1 , indev2
41 ve(indev,1,k)=cons0
42 (indev,2,k)=cons0
43 enddo
44
45 do j=1,levs
46 do indev = indev1 , indev2
47 ve(indev,1,k)=ve(indev,1,k)+amhyb(k,j)*ye(indev,1,j)
48 ve(indev,2,k)=ve(indev,2,k)+amhyb(k,j)*ye(indev,2,j)
49 enddo
50 enddo
51
52 do indev = indev1 , indev2
53 ue(indev,1,k)=xe(indev,1,k)
54 & +dt*snnp1ev(indev)*(ve(indev,1,k)+tor_hyb(k)*ze(indev,1))
55
56 ue(indev,2,k)=xe(indev,2,k)
57 & +dt*snnp1ev(indev)*(ve(indev,2,k)+tor_hyb(k)*ze(indev,2))
58 enddo
59
60 enddo
61
62 do k=1,levs
63
64 do indev = indev1 , indev2
65 ve(indev,1,k)=cons0
66 (indev,2,k)=cons0
67 enddo
68
69 do j=1,levs
70 do indev = indev1 , indev2
71 ve(indev,1,k)=
72 x ve(indev,1,k) +dm205_hyb(ndexev(indev)+1,k,j)*ue(indev,1,j)
73 ve(indev,2,k)=
74 x ve(indev,2,k) +dm205_hyb(ndexev(indev)+1,k,j)*ue(indev,2,j)
75
76
77
78
79 enddo
80 enddo
81
82 enddo
83
84 do j=1,levs
85
86 do indev = indev1 , indev2
87 qe(indev,1)=qe(indev,1)-dt*svhyb(j)*ve(indev,1,j)
88 qe(indev,2)=qe(indev,2)-dt*svhyb(j)*ve(indev,2,j)
89 enddo
90
91 enddo
92
93 do indev = indev1 , indev2
94 qe(indev,1)=qe(indev,1)+ze(indev,1)
95 qe(indev,2)=qe(indev,2)+ze(indev,2)
96 enddo
97
98 do k=1,levs
99
100 do j=1,levs
101 do indev = indev1 , indev2
102 te(indev,1,k)=te(indev,1,k)-dt*bmhyb(k,j)*ve(indev,1,j)
103 te(indev,2,k)=te(indev,2,k)-dt*bmhyb(k,j)*ve(indev,2,j)
104 enddo
105 enddo
106
107 do indev = indev1 , indev2
108 te(indev,1,k)=te(indev,1,k)+ye(indev,1,k)
109 te(indev,2,k)=te(indev,2,k)+ye(indev,2,k)
110
111 de(indev,1,k)=de(indev,1,k)+ve(indev,1,k)
112 de(indev,2,k)=de(indev,2,k)+ve(indev,2,k)
113 enddo
114
115 enddo
116
117
118
119 return
120 end
121 subroutine impadjo_hyb_gc(do,to,qo,xo,yo,zo,
122 x dti,uo,vo,snnp1od,ndexod,
123 x ls_node,locl)
124 use gfs_dyn_resol_def
125 use gfs_dyn_layout1
126 use gfs_dyn_coordinate_def
127 implicit none
128 real(kind=kind_evod) do(len_trio_ls,2,levs),to(len_trio_ls,2,levs)
129 real(kind=kind_evod) xo(len_trio_ls,2,levs),yo(len_trio_ls,2,levs)
130 real(kind=kind_evod) uo(len_trio_ls,2,levs),vo(len_trio_ls,2,levs)
131 real(kind=kind_evod) qo(len_trio_ls,2), zo(len_trio_ls,2)
132 real(kind=kind_evod) dti,dt
133 real(kind=kind_evod) snnp1od(len_trio_ls)
134 integer ndexod(len_trio_ls)
135 integer j,k
136 integer ls_node(ls_dim,3)
137 integer indod,indod1,indod2,l,locl,n
138 integer indlsev,jbasev
139 integer indlsod,jbasod
140 include 'function2'
141 real(kind=kind_evod) cons0
142
143
144
145
146 =dti*(1.+eps_si)
147
148 cons0 = 0.d0
149 = ls_node(locl,1)
150 jbasod = ls_node(locl,3)
151 indod1 = indlsod(L+1,L)
152 if (mod(L,2).eq.mod(jcap+1,2)) then
153 indod2 = indlsod(jcap ,L)
154 else
155 indod2 = indlsod(jcap+1,L)
156 endif
157 do k=1,levs
158
159 do indod = indod1 , indod2
160 vo(indod,1,k)=cons0
161 (indod,2,k)=cons0
162 enddo
163
164 do j=1,levs
165 do indod = indod1 , indod2
166 vo(indod,1,k)=vo(indod,1,k)+amhyb(k,j)*yo(indod,1,j)
167 vo(indod,2,k)=vo(indod,2,k)+amhyb(k,j)*yo(indod,2,j)
168 enddo
169 enddo
170
171 do indod = indod1 , indod2
172 uo(indod,1,k)=xo(indod,1,k)
173 & +dt*snnp1od(indod)*(vo(indod,1,k)+tor_hyb(k)*zo(indod,1))
174
175 uo(indod,2,k)=xo(indod,2,k)
176 & +dt*snnp1od(indod)*(vo(indod,2,k)+tor_hyb(k)*zo(indod,2))
177 enddo
178
179 enddo
180
181 do k=1,levs
182
183 do indod = indod1 , indod2
184 vo(indod,1,k)=cons0
185 (indod,2,k)=cons0
186 enddo
187
188 do j=1,levs
189 do indod = indod1 , indod2
190 vo(indod,1,k)=
191 x vo(indod,1,k) +dm205_hyb(ndexod(indod)+1,k,j)*uo(indod,1,j)
192 vo(indod,2,k)=
193 x vo(indod,2,k) +dm205_hyb(ndexod(indod)+1,k,j)*uo(indod,2,j)
194
195
196
197
198 enddo
199 enddo
200
201 enddo
202
203 do j=1,levs
204
205 do indod = indod1 , indod2
206 qo(indod,1)=qo(indod,1)-dt*svhyb(j)*vo(indod,1,j)
207 qo(indod,2)=qo(indod,2)-dt*svhyb(j)*vo(indod,2,j)
208 enddo
209
210 enddo
211
212 do indod = indod1 , indod2
213 qo(indod,1)=qo(indod,1)+zo(indod,1)
214 qo(indod,2)=qo(indod,2)+zo(indod,2)
215 enddo
216
217 do k=1,levs
218
219 do j=1,levs
220 do indod = indod1 , indod2
221 to(indod,1,k)=to(indod,1,k)-dt*bmhyb(k,j)*vo(indod,1,j)
222 to(indod,2,k)=to(indod,2,k)-dt*bmhyb(k,j)*vo(indod,2,j)
223 enddo
224 enddo
225
226 do indod = indod1 , indod2
227 to(indod,1,k)=to(indod,1,k)+yo(indod,1,k)
228 to(indod,2,k)=to(indod,2,k)+yo(indod,2,k)
229
230 do(indod,1,k)=do(indod,1,k)+vo(indod,1,k)
231 do(indod,2,k)=do(indod,2,k)+vo(indod,2,k)
232 enddo
233
234 enddo
235
236
237
238 return
239 end
240