File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\do_dynamics_mod.f
1 module do_dynamics_mod
2
3 use gfs_dyn_resol_def
4 use gfs_dyn_layout1
5 implicit none
6 private
7
8 public do_dynamics_gridc2syn
9 public do_dynamics_gridt2anl
10 public do_dynamics_gridn2anl
11 public do_dynamics_gridm2sym
12 public do_dynamics_spectupdatewrt
13 public do_dynamics_spectupdatexyzq
14 public do_dynamics_spectn2c
15 public do_dynamics_spectn2m
16 public do_dynamics_spectc2n
17 public do_dynamics_syn2gridn
18 public do_dynamics_gridomega
19 public do_dynamics_gridfilter
20 public do_dynamics_gridn2c
21 public do_dynamics_gridc2n
22 public do_dynamics_gridn2m
23 public do_dynamics_gridupdate
24 public do_dynamics_gridpdp
25 public do_dynamics_griddpm
26 public do_dynamics_gridcheck
27
28 contains
29
30
31
32 subroutine do_dynamics_gridc2syn(grid_gr,syn_gr_a_2,
33 & global_lats_a,lonsperlat)
34
35 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
36 real(kind=kind_evod) syn_gr_a_2(lonfx*lots,lats_dim_ext)
37 integer,intent(in):: global_lats_a(latg)
38 integer,intent(in):: lonsperlat(latg)
39
40 integer lan,lat,lon_dim,lons_lat,k,i
41 integer jlonf,ilan
42
43 do lan=1,lats_node_a
44 lat = global_lats_a(ipt_lats_node_a-1+lan)
45 lon_dim = lon_dims_a(lan)
46 lons_lat = lonsperlat(lat)
47 jlonf = (lan-1)*lonf
48 do k=1,levs
49 do i=1,lons_lat
50 ilan=i+jlonf
51 syn_gr_a_2(i+(ksu-2+k)*lon_dim,lan)=grid_gr(ilan,g_uu+k-1)
52 syn_gr_a_2(i+(ksv-2+k)*lon_dim,lan)=grid_gr(ilan,g_vv+k-1)
53 syn_gr_a_2(i+(kst-2+k)*lon_dim,lan)=grid_gr(ilan,g_tt+k-1)
54 enddo
55 enddo
56 do k=1,levh
57 do i=1,lons_lat
58 ilan=i+jlonf
59 syn_gr_a_2(i+(ksr-2+k)*lon_dim,lan)=grid_gr(ilan,g_rq+k-1)
60 enddo
61 enddo
62 do i=1,lons_lat
63 ilan=i+jlonf
64 syn_gr_a_2(i+(ksq-1)*lon_dim,lan)=grid_gr(ilan,g_q)
65 enddo
66 enddo
67
68 return
69 end subroutine do_dynamics_gridc2syn
70
71
72 subroutine do_dynamics_gridn2anl(grid_gr,anl_gr_a_2,
73 & global_lats_a,lonsperlat)
74
75 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
76 real(kind=kind_evod) anl_gr_a_2(lonfx*lota,lats_dim_ext)
77 integer,intent(in):: global_lats_a(latg)
78 integer,intent(in):: lonsperlat(latg)
79
80 integer lan,lat,lon_dim,lons_lat,k,i
81 integer jlonf,ilan
82
83 do lan=1,lats_node_a
84 lat = global_lats_a(ipt_lats_node_a-1+lan)
85 lon_dim = lon_dims_a(lan)
86 lons_lat = lonsperlat(lat)
87 jlonf = (lan-1)*lonf
88 do k=1,levs
89 do i=1,lons_lat
90 ilan=i+jlonf
91 anl_gr_a_2(i+(kau-2+k)*lon_dim,lan)=grid_gr(ilan,g_u +k-1)
92 anl_gr_a_2(i+(kav-2+k)*lon_dim,lan)=grid_gr(ilan,g_v +k-1)
93 anl_gr_a_2(i+(kat-2+k)*lon_dim,lan)=grid_gr(ilan,g_t +k-1)
94 enddo
95 enddo
96 do k=1,levh
97 do i=1,lons_lat
98 ilan=i+jlonf
99 anl_gr_a_2(i+(kar-2+k)*lon_dim,lan)=grid_gr(ilan,g_rt +k-1)
100 enddo
101 enddo
102 do i=1,lons_lat
103 ilan=i+jlonf
104 anl_gr_a_2(i+(kaps-1)*lon_dim,lan)=grid_gr(ilan,g_zq)
105 enddo
106 enddo
107
108 return
109 end subroutine do_dynamics_gridn2anl
110
111
112 subroutine do_dynamics_gridm2sym(grid_gr,sym_gr_a_2,
113 & global_lats_a,lonsperlat)
114
115 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
116 real(kind=kind_evod) sym_gr_a_2(lonfx*lotm,lats_dim_ext)
117 integer,intent(in):: global_lats_a(latg)
118 integer,intent(in):: lonsperlat(latg)
119
120 integer lan,lat,lon_dim,lons_lat,k,i
121 integer jlonf,ilan
122
123 do lan=1,lats_node_a
124 lat = global_lats_a(ipt_lats_node_a-1+lan)
125 lon_dim = lon_dims_a(lan)
126 lons_lat = lonsperlat(lat)
127 jlonf = (lan-1)*lonf
128 do k=1,levs
129 do i=1,lons_lat
130 ilan=i+jlonf
131 sym_gr_a_2(i+(ksum-2+k)*lon_dim,lan)=grid_gr(ilan,g_uum+k-1)
132 sym_gr_a_2(i+(ksvm-2+k)*lon_dim,lan)=grid_gr(ilan,g_vvm+k-1)
133 sym_gr_a_2(i+(kstm-2+k)*lon_dim,lan)=grid_gr(ilan,g_ttm+k-1)
134 enddo
135 enddo
136 do k=1,levh
137 do i=1,lons_lat
138 ilan=i+jlonf
139 sym_gr_a_2(i+(ksrm-2+k)*lon_dim,lan)=grid_gr(ilan,g_rm +k-1)
140 enddo
141 enddo
142 do i=1,lons_lat
143 ilan=i+jlonf
144 sym_gr_a_2(i+(kspsm-1)*lon_dim,lan)=grid_gr(ilan,g_qm)
145 enddo
146 enddo
147
148 return
149 end subroutine do_dynamics_gridm2sym
150
151
152 subroutine do_dynamics_gridt2anl(grid_gr,anl_gr_a_2,rdt2,
153 & global_lats_a,lonsperlat)
154
155 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
156 real(kind=kind_evod) anl_gr_a_2(lonfx*lota,lats_dim_ext)
157 integer,intent(in):: global_lats_a(latg)
158 integer,intent(in):: lonsperlat(latg)
159
160 real rdt2
161 integer lan,lat,lon_dim,lons_lat,k,i
162 integer jlonf,ilan
163
164 do lan=1,lats_node_a
165 lat = global_lats_a(ipt_lats_node_a-1+lan)
166 lon_dim = lon_dims_a(lan)
167 lons_lat = lonsperlat(lat)
168 jlonf = (lan-1)*lonf
169 do k=1,levs
170 do i=1,lons_lat
171 ilan=i+jlonf
172 anl_gr_a_2(i+(kau-2+k)*lon_dim,lan)=
173 & (grid_gr(ilan,G_u +k-1)-grid_gr(ilan,G_uum+k-1))*rdt2
174 anl_gr_a_2(i+(kav-2+k)*lon_dim,lan)=
175 & (grid_gr(ilan,G_v +k-1)-grid_gr(ilan,G_vvm+k-1))*rdt2
176 anl_gr_a_2(i+(kat-2+k)*lon_dim,lan)=
177 & (grid_gr(ilan,G_t +k-1)-grid_gr(ilan,G_ttm+k-1))*rdt2
178 enddo
179 enddo
180 do k=1,levh
181 do i=1,lons_lat
182 ilan=i+jlonf
183 anl_gr_a_2(i+(kar-2+k)*lon_dim,lan)=
184 & (grid_gr(ilan,G_rt +k-1)-grid_gr(ilan,G_rm +k-1))*rdt2
185 enddo
186 enddo
187 do i=1,lons_lat
188 ilan=i+jlonf
189 anl_gr_a_2(i+(kaps-1)*lon_dim,lan)=
190 & (grid_gr(ilan,G_zq)-grid_gr(ilan,G_qm))*rdt2
191 enddo
192 enddo
193
194 return
195 end subroutine do_dynamics_gridt2anl
196
197
198 subroutine do_dynamics_spectupdatewrt(trie_ls,trio_ls,dt2)
199
200 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
201 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
202 real, intent(in):: dt2
203
204 integer k,i
205
206 do k=1,levs
207 do i=1,len_trie_ls
208 trie_ls(i,1,P_w +k-1)=
209 & trie_ls(i,1,P_zem+k-1)+dt2*trie_ls(i,1,P_w+k-1)
210 trie_ls(i,2,P_w +k-1)=
211 & trie_ls(i,2,P_zem+k-1)+dt2*trie_ls(i,2,P_w+k-1)
212 enddo
213 do i=1,len_trio_ls
214 trio_ls(i,1,P_w +k-1)=
215 & trio_ls(i,1,P_zem+k-1)+dt2*trio_ls(i,1,P_w+k-1)
216 trio_ls(i,2,P_w +k-1)=
217 & trio_ls(i,2,P_zem+k-1)+dt2*trio_ls(i,2,P_w+k-1)
218 enddo
219 enddo
220 do k=1,levh
221 do i=1,len_trie_ls
222 trie_ls(i,1,P_rt+k-1)=
223 & trie_ls(i,1,P_rm+k-1)+dt2* trie_ls(i,1,P_rt+k-1)
224 trie_ls(i,2,P_rt+k-1)=
225 & trie_ls(i,2,P_rm+k-1)+dt2* trie_ls(i,2,P_rt+k-1)
226 enddo
227 do i=1,len_trio_ls
228 trio_ls(i,1,P_rt+k-1)=
229 & trio_ls(i,1,P_rm+k-1)+dt2* trio_ls(i,1,P_rt+k-1)
230 trio_ls(i,2,P_rt+k-1)=
231 & trio_ls(i,2,P_rm+k-1)+dt2* trio_ls(i,2,P_rt+k-1)
232 enddo
233 enddo
234
235 return
236 end subroutine do_dynamics_spectupdatewrt
237
238
239 subroutine do_dynamics_spectupdatexyzq(trie_ls,trio_ls,dt2)
240
241 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
242 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
243 real, intent(in):: dt2
244
245 integer k,i
246
247 do k=1,levs
248 do i=1,len_trie_ls
249 trie_ls(i,1,P_x +k-1)=
250 & trie_ls(i,1,P_dim+k-1)+dt2*trie_ls(i,1,P_x+k-1)
251 trie_ls(i,2,P_x +k-1)=
252 & trie_ls(i,2,P_dim+k-1)+dt2*trie_ls(i,2,P_x+k-1)
253 trie_ls(i,1,P_y +k-1)=
254 & trie_ls(i,1,P_tem+k-1)+dt2*trie_ls(i,1,P_y+k-1)
255 trie_ls(i,2,P_y +k-1)=
256 & trie_ls(i,2,P_tem+k-1)+dt2*trie_ls(i,2,P_y+k-1)
257 enddo
258 do i=1,len_trio_ls
259 trio_ls(i,1,P_x +k-1)=
260 & trio_ls(i,1,P_dim+k-1)+dt2*trio_ls(i,1,P_x+k-1)
261 trio_ls(i,2,P_x +k-1)=
262 & trio_ls(i,2,P_dim+k-1)+dt2*trio_ls(i,2,P_x+k-1)
263 trio_ls(i,1,P_y +k-1)=
264 & trio_ls(i,1,P_tem+k-1)+dt2*trio_ls(i,1,P_y+k-1)
265 trio_ls(i,2,P_y +k-1)=
266 & trio_ls(i,2,P_tem+k-1)+dt2*trio_ls(i,2,P_y+k-1)
267 enddo
268 enddo
269
270 do i=1,len_trie_ls
271 trie_ls(i,1,P_zq)=
272 & trie_ls(i,1,P_qm)+dt2*trie_ls(i,1,P_zq)
273 trie_ls(i,2,P_zq)=
274 & trie_ls(i,2,P_qm)+dt2*trie_ls(i,2,P_zq)
275 enddo
276 do i=1,len_trio_ls
277 trio_ls(i,1,P_zq)=
278 & trio_ls(i,1,P_qm)+dt2*trio_ls(i,1,P_zq)
279 trio_ls(i,2,P_zq)=
280 & trio_ls(i,2,P_qm)+dt2*trio_ls(i,2,P_zq)
281 enddo
282
283 return
284 end subroutine do_dynamics_spectupdatexyzq
285
286
287 subroutine do_dynamics_spectn2c(trie_ls,trio_ls)
288
289 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
290 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
291
292 integer k,j
293
294 DO K=1,LEVS
295 DO J=1,LEN_TRIE_LS
296 TRIE_LS(J,1,P_DI+K-1)=TRIE_LS(J,1,P_X+K-1)
297 TRIE_LS(J,2,P_DI+K-1)=TRIE_LS(J,2,P_X+K-1)
298 TRIE_LS(J,1,P_ZE+K-1)=TRIE_LS(J,1,P_W+K-1)
299 TRIE_LS(J,2,P_ZE+K-1)=TRIE_LS(J,2,P_W+K-1)
300 TRIE_LS(J,1,P_TE+K-1)=TRIE_LS(J,1,P_Y+K-1)
301 TRIE_LS(J,2,P_TE+K-1)=TRIE_LS(J,2,P_Y+K-1)
302 ENDDO
303 DO J=1,LEN_TRIO_LS
304 TRIO_LS(J,1,P_DI+K-1)=TRIO_LS(J,1,P_X+K-1)
305 TRIO_LS(J,2,P_DI+K-1)=TRIO_LS(J,2,P_X+K-1)
306 TRIO_LS(J,1,P_ZE+K-1)=TRIO_LS(J,1,P_W+K-1)
307 TRIO_LS(J,2,P_ZE+K-1)=TRIO_LS(J,2,P_W+K-1)
308 TRIO_LS(J,1,P_TE+K-1)=TRIO_LS(J,1,P_Y+K-1)
309 TRIO_LS(J,2,P_TE+K-1)=TRIO_LS(J,2,P_Y+K-1)
310 ENDDO
311 ENDDO
312 DO K=1,LEVH
313 DO J=1,LEN_TRIE_LS
314 TRIE_LS(J,1,P_RQ+K-1)=TRIE_LS(J,1,P_RT+K-1)
315 TRIE_LS(J,2,P_RQ+K-1)=TRIE_LS(J,2,P_RT+K-1)
316 ENDDO
317 DO J=1,LEN_TRIO_LS
318 TRIO_LS(J,1,P_RQ+K-1)=TRIO_LS(J,1,P_RT+K-1)
319 TRIO_LS(J,2,P_RQ+K-1)=TRIO_LS(J,2,P_RT+K-1)
320 ENDDO
321 ENDDO
322 DO J=1,LEN_TRIE_LS
323 TRIE_LS(J,1,P_Q)=TRIE_LS(J,1,P_ZQ)
324 TRIE_LS(J,2,P_Q)=TRIE_LS(J,2,P_ZQ)
325 ENDDO
326 DO J=1,LEN_TRIO_LS
327 TRIO_LS(J,1,P_Q)=TRIO_LS(J,1,P_ZQ)
328 TRIO_LS(J,2,P_Q)=TRIO_LS(J,2,P_ZQ)
329 ENDDO
330
331 return
332 end subroutine do_dynamics_spectn2c
333
334
335 subroutine do_dynamics_spectn2m(trie_ls,trio_ls)
336
337 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
338 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
339
340 integer k,j
341
342 DO K=1,LEVS
343 DO J=1,LEN_TRIE_LS
344 TRIE_LS(J,1,P_DIM+K-1)=TRIE_LS(J,1,P_X+K-1)
345 TRIE_LS(J,2,P_DIM+K-1)=TRIE_LS(J,2,P_X+K-1)
346 TRIE_LS(J,1,P_ZEM+K-1)=TRIE_LS(J,1,P_W+K-1)
347 TRIE_LS(J,2,P_ZEM+K-1)=TRIE_LS(J,2,P_W+K-1)
348 TRIE_LS(J,1,P_TEM+K-1)=TRIE_LS(J,1,P_Y+K-1)
349 TRIE_LS(J,2,P_TEM+K-1)=TRIE_LS(J,2,P_Y+K-1)
350 ENDDO
351 DO J=1,LEN_TRIO_LS
352 TRIO_LS(J,1,P_DIM+K-1)=TRIO_LS(J,1,P_X+K-1)
353 TRIO_LS(J,2,P_DIM+K-1)=TRIO_LS(J,2,P_X+K-1)
354 TRIO_LS(J,1,P_ZEM+K-1)=TRIO_LS(J,1,P_W+K-1)
355 TRIO_LS(J,2,P_ZEM+K-1)=TRIO_LS(J,2,P_W+K-1)
356 TRIO_LS(J,1,P_TEM+K-1)=TRIO_LS(J,1,P_Y+K-1)
357 TRIO_LS(J,2,P_TEM+K-1)=TRIO_LS(J,2,P_Y+K-1)
358 ENDDO
359 ENDDO
360 DO K=1,LEVH
361 DO J=1,LEN_TRIE_LS
362 TRIE_LS(J,1,P_RM+K-1)=TRIE_LS(J,1,P_RT+K-1)
363 TRIE_LS(J,2,P_RM+K-1)=TRIE_LS(J,2,P_RT+K-1)
364 ENDDO
365 DO J=1,LEN_TRIO_LS
366 TRIO_LS(J,1,P_RM+K-1)=TRIO_LS(J,1,P_RT+K-1)
367 TRIO_LS(J,2,P_RM+K-1)=TRIO_LS(J,2,P_RT+K-1)
368 ENDDO
369 ENDDO
370 DO J=1,LEN_TRIE_LS
371 TRIE_LS(J,1,P_QM)=TRIE_LS(J,1,P_ZQ)
372 TRIE_LS(J,2,P_QM)=TRIE_LS(J,2,P_ZQ)
373 ENDDO
374 DO J=1,LEN_TRIO_LS
375 TRIO_LS(J,1,P_QM)=TRIO_LS(J,1,P_ZQ)
376 TRIO_LS(J,2,P_QM)=TRIO_LS(J,2,P_ZQ)
377 ENDDO
378
379 return
380 end subroutine do_dynamics_spectn2m
381
382
383 subroutine do_dynamics_spectc2n(trie_ls,trio_ls)
384
385 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
386 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
387
388 integer k,j
389
390 DO K=1,LEVS
391 DO J=1,LEN_TRIE_LS
392 TRIE_LS(J,1,P_X+K-1)=TRIE_LS(J,1,P_DI+K-1)
393 TRIE_LS(J,2,P_X+K-1)=TRIE_LS(J,2,P_DI+K-1)
394 TRIE_LS(J,1,P_W+K-1)=TRIE_LS(J,1,P_ZE+K-1)
395 TRIE_LS(J,2,P_W+K-1)=TRIE_LS(J,2,P_ZE+K-1)
396 TRIE_LS(J,1,P_Y+K-1)=TRIE_LS(J,1,P_TE+K-1)
397 TRIE_LS(J,2,P_Y+K-1)=TRIE_LS(J,2,P_TE+K-1)
398 ENDDO
399 DO J=1,LEN_TRIO_LS
400 TRIO_LS(J,1,P_X+K-1)=TRIO_LS(J,1,P_DI+K-1)
401 TRIO_LS(J,2,P_X+K-1)=TRIO_LS(J,2,P_DI+K-1)
402 TRIO_LS(J,1,P_W+K-1)=TRIO_LS(J,1,P_ZE+K-1)
403 TRIO_LS(J,2,P_W+K-1)=TRIO_LS(J,2,P_ZE+K-1)
404 TRIO_LS(J,1,P_Y+K-1)=TRIO_LS(J,1,P_TE+K-1)
405 TRIO_LS(J,2,P_Y+K-1)=TRIO_LS(J,2,P_TE+K-1)
406 ENDDO
407 ENDDO
408 DO K=1,LEVH
409 DO J=1,LEN_TRIE_LS
410 TRIE_LS(J,1,P_RT+K-1)=TRIE_LS(J,1,P_RQ+K-1)
411 TRIE_LS(J,2,P_RT+K-1)=TRIE_LS(J,2,P_RQ+K-1)
412 ENDDO
413 DO J=1,LEN_TRIO_LS
414 TRIO_LS(J,1,P_RT+K-1)=TRIO_LS(J,1,P_RQ+K-1)
415 TRIO_LS(J,2,P_RT+K-1)=TRIO_LS(J,2,P_RQ+K-1)
416 ENDDO
417 ENDDO
418 DO J=1,LEN_TRIE_LS
419 TRIE_LS(J,1,P_ZQ)=TRIE_LS(J,1,P_Q)
420 TRIE_LS(J,2,P_ZQ)=TRIE_LS(J,2,P_Q)
421 ENDDO
422 DO J=1,LEN_TRIO_LS
423 TRIO_LS(J,1,P_ZQ)=TRIO_LS(J,1,P_Q)
424 TRIO_LS(J,2,P_ZQ)=TRIO_LS(J,2,P_Q)
425 ENDDO
426
427 return
428 end subroutine do_dynamics_spectc2n
429
430
431 subroutine do_dynamics_syn2gridn(syn_gr_a_2,grid_gr,
432 & global_lats_a,lonsperlat,nislfv)
433
434 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
435 real(kind=kind_evod) syn_gr_a_2(lonfx*lots,lats_dim_ext)
436 integer,intent(in):: global_lats_a(latg)
437 integer,intent(in):: lonsperlat(latg)
438 integer,intent(in):: nislfv
439
440 integer lan,lat,lon_dim,lons_lat,k,i
441 integer jlonf,ilan
442
443 do lan=1,lats_node_a
444 lat = global_lats_a(ipt_lats_node_a-1+lan)
445 lon_dim = lon_dims_a(lan)
446 lons_lat = lonsperlat(lat)
447 jlonf = (lan-1)*lonf
448 do k=1,levs
449 do i=1,lons_lat
450 ilan=i+jlonf
451 grid_gr(ilan,G_u+k-1)= syn_gr_a_2(i+(ksu-2+k)*lon_dim,lan)
452 grid_gr(ilan,G_v+k-1)= syn_gr_a_2(i+(ksv-2+k)*lon_dim,lan)
453 grid_gr(ilan,G_t+k-1)= syn_gr_a_2(i+(kst-2+k)*lon_dim,lan)
454 enddo
455 enddo
456
457 if( nislfv.le.1 ) then
458
459 do k=1,levh
460 do i=1,lons_lat
461 ilan=i+jlonf
462 grid_gr(ilan,G_rt+k-1)= syn_gr_a_2(i+(ksr-2+k)*lon_dim,lan)
463 enddo
464 enddo
465 endif
466
467 do i=1,lons_lat
468 ilan=i+jlonf
469 grid_gr(ilan,G_zq)= syn_gr_a_2(i+(ksq-1)*lon_dim,lan)
470 enddo
471 enddo
472
473 return
474 end subroutine do_dynamics_syn2gridn
475
476
477 subroutine do_dynamics_gridomega(syn_gr_a_2,dyn_gr_a_2,
478 & grid_gr,rcs2,
479 & global_lats_a,lonsperlat)
480
481 use namelist_dynamics_def
482
483 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
484 real(kind=kind_evod) syn_gr_a_2(lonfx*lots,lats_dim_ext)
485 real(kind=kind_evod) dyn_gr_a_2(lonfx*lotd,lats_dim_ext)
486 real(kind=kind_grid) rcs2(latg2)
487 integer,intent(in):: global_lats_a(latg)
488 integer,intent(in):: lonsperlat(latg)
489
490 real(kind=kind_grid) ugr (lonf,levs), vgr (lonf,levs)
491 real(kind=kind_grid) gtv (lonf,levs), gd (lonf,levs)
492 real(kind=kind_grid) gtvx(lonf,levs), gtvy(lonf,levs)
493 real(kind=kind_grid) gphi(lonf) , glam(lonf) , gq (lonf)
494 real(kind=kind_grid) vvel(lonf,levs)
495
496 integer lan,lat,lon_dim,lons_lat,k,i
497 integer jlonf,ilan
498
499 do lan=1,lats_node_a
500 lat = global_lats_a(ipt_lats_node_a-1+lan)
501 lon_dim = lon_dims_a(lan)
502 lons_lat = lonsperlat(lat)
503 jlonf = (lan-1)*lonf
504
505 do k=1,levs
506 do i=1,lons_lat
507 ugr (i,k)= syn_gr_a_2(i+(ksu-2+k)*lon_dim,lan)
508 vgr (i,k)= syn_gr_a_2(i+(ksv-2+k)*lon_dim,lan)
509 gd (i,k)= syn_gr_a_2(i+(ksd-2+k)*lon_dim,lan)
510 gtv (i,k)= syn_gr_a_2(i+(kst-2+k)*lon_dim,lan)
511 gtvx(i,k)= dyn_gr_a_2(i+(kdtlam-2+k)*lon_dim,lan)
512 gtvy(i,k)= dyn_gr_a_2(i+(kdtphi-2+k)*lon_dim,lan)
513 enddo
514 enddo
515 do i=1,lons_lat
516 gq (i)=syn_gr_a_2(i+(ksq -1)*lon_dim,lan)
517 gphi(i)=syn_gr_a_2(i+(kspphi-1)*lon_dim,lan)
518 glam(i)=syn_gr_a_2(i+(ksplam-1)*lon_dim,lan)
519 enddo
520
521 if( gen_coord_hybrid ) then
522 call omega_gch(lons_lat,lonf,rcs2(min(lat,latg-lat+1)),
523 & gq,gphi,glam,gtv,gtvx,gtvy,gd,ugr,vgr,vvel)
524 else if( hybrid )then
525 call omega_hyb(lons_lat,lonf,rcs2(min(lat,latg-lat+1)),
526 & gq,gphi,glam,gd,ugr,vgr,vvel)
527 else
528 call omega_sig(lons_lat,lonf,rcs2(min(lat,latg-lat+1)),
529 & gq,gphi,glam,gd,ugr,vgr,vvel)
530 endif
531
532 do k=1,levs
533 do i=1,lons_lat
534 ilan=i+jlonf
535 grid_gr(ilan,g_dpdt+k-1)=vvel(i,k)
536 enddo
537 enddo
538
539 enddo
540
541 return
542 end subroutine do_dynamics_gridomega
543
544
545 subroutine do_dynamics_gridfilter(grid_gr,filta,filtb,
546 & global_lats_a,lonsperlat)
547
548 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
549 integer,intent(in):: global_lats_a(latg)
550 integer,intent(in):: lonsperlat(latg)
551 real, intent(in):: filta, filtb
552
553 integer lan,lat,lons_lat,k,i
554 integer jlonf,ilan
555
556 do lan=1,lats_node_a
557 lat = global_lats_a(ipt_lats_node_a-1+lan)
558 lons_lat = lonsperlat(lat)
559 jlonf = (lan-1)*lonf
560 do k=1,levs
561 do i=1,lons_lat
562 ilan=i+jlonf
563 grid_gr(ilan,G_uum+k-1)=grid_gr(ilan,G_uu +k-1) *filta+
564 & (grid_gr(ilan,G_uum+k-1)+grid_gr(ilan,G_u +k-1))*filtb
565 grid_gr(ilan,G_vvm+k-1)=grid_gr(ilan,G_vv +k-1) *filta+
566 & (grid_gr(ilan,G_vvm+k-1)+grid_gr(ilan,G_v +k-1))*filtb
567 grid_gr(ilan,G_ttm+k-1)=grid_gr(ilan,G_tt +k-1) *filta+
568 & (grid_gr(ilan,G_ttm+k-1)+grid_gr(ilan,G_t +k-1))*filtb
569 grid_gr(ilan,G_uu +k-1)=grid_gr(ilan,G_u +k-1)
570 grid_gr(ilan,G_vv +k-1)=grid_gr(ilan,G_v +k-1)
571 grid_gr(ilan,G_tt +k-1)=grid_gr(ilan,G_t +k-1)
572 enddo
573 enddo
574 do k=1,levh
575 do i=1,lons_lat
576 ilan=i+jlonf
577 grid_gr(ilan,G_rm +k-1)=grid_gr(ilan,G_rq +k-1) *filta+
578 & (grid_gr(ilan,G_rm +k-1)+grid_gr(ilan,G_rt +k-1))*filtb
579 grid_gr(ilan,G_rq +k-1)=grid_gr(ilan,G_rt +k-1)
580 enddo
581 enddo
582 do i=1,lons_lat
583 ilan=i+jlonf
584 grid_gr(ilan,G_qm)=grid_gr(ilan,G_q )
585 grid_gr(ilan,G_q )=grid_gr(ilan,G_zq)
586 enddo
587 enddo
588
589 return
590 end subroutine do_dynamics_gridfilter
591
592
593 subroutine do_dynamics_gridn2c(grid_gr,
594 & global_lats_a,lonsperlat)
595
596 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
597 integer,intent(in):: global_lats_a(latg)
598 integer,intent(in):: lonsperlat(latg)
599
600 integer lan,lat,lons_lat,k,i
601 integer jlonf,ilan
602
603 do lan=1,lats_node_a
604 lat = global_lats_a(ipt_lats_node_a-1+lan)
605 lons_lat = lonsperlat(lat)
606 jlonf = (lan-1)*lonf
607 do k=1,levs
608 do i=1,lons_lat
609 ilan=i+jlonf
610 grid_gr(ilan,G_uu +k-1)=grid_gr(ilan,G_u +k-1)
611 grid_gr(ilan,G_vv +k-1)=grid_gr(ilan,G_v +k-1)
612 grid_gr(ilan,G_tt +k-1)=grid_gr(ilan,G_t +k-1)
613 enddo
614 enddo
615 do k=1,levh
616 do i=1,lons_lat
617 ilan=i+jlonf
618 grid_gr(ilan,G_rq +k-1)=grid_gr(ilan,G_rt +k-1)
619 enddo
620 enddo
621 do i=1,lons_lat
622 ilan=i+jlonf
623 grid_gr(ilan,G_q )=grid_gr(ilan,G_zq)
624 enddo
625 enddo
626
627 return
628 end subroutine do_dynamics_gridn2c
629
630
631 subroutine do_dynamics_gridc2n(grid_gr,
632 & global_lats_a,lonsperlat)
633
634 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
635 integer,intent(in):: global_lats_a(latg)
636 integer,intent(in):: lonsperlat(latg)
637
638 integer lan,lat,lons_lat,k,i
639 integer jlonf,ilan
640
641 do lan=1,lats_node_a
642 lat = global_lats_a(ipt_lats_node_a-1+lan)
643 lons_lat = lonsperlat(lat)
644 jlonf = (lan-1)*lonf
645 do k=1,levs
646 do i=1,lons_lat
647 ilan=i+jlonf
648 grid_gr(ilan,G_u+k-1)=grid_gr(ilan,G_uu +k-1)
649 grid_gr(ilan,G_v+k-1)=grid_gr(ilan,G_vv +k-1)
650 grid_gr(ilan,G_t+k-1)=grid_gr(ilan,G_tt +k-1)
651 enddo
652 enddo
653 do k=1,levh
654 do i=1,lons_lat
655 ilan=i+jlonf
656 grid_gr(ilan,G_rt +k-1)=grid_gr(ilan,G_rq +k-1)
657 enddo
658 enddo
659 do i=1,lons_lat
660 ilan=i+jlonf
661 grid_gr(ilan,G_zq)=grid_gr(ilan,G_q)
662 enddo
663 enddo
664
665 return
666 end subroutine do_dynamics_gridc2n
667
668
669
670 subroutine do_dynamics_gridn2m(grid_gr,
671 & global_lats_a,lonsperlat)
672
673 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
674 integer,intent(in):: global_lats_a(latg)
675 integer,intent(in):: lonsperlat(latg)
676
677 integer lan,lat,lons_lat,k,i
678 integer jlonf,ilan
679
680 do lan=1,lats_node_a
681 lat = global_lats_a(ipt_lats_node_a-1+lan)
682 lons_lat = lonsperlat(lat)
683 jlonf = (lan-1)*lonf
684 do k=1,levs
685 do i=1,lons_lat
686 ilan=i+jlonf
687 grid_gr(ilan,G_uum+k-1)=grid_gr(ilan,G_u +k-1)
688 grid_gr(ilan,G_vvm+k-1)=grid_gr(ilan,G_v +k-1)
689 grid_gr(ilan,G_ttm+k-1)=grid_gr(ilan,G_t +k-1)
690 enddo
691 enddo
692 do k=1,levh
693 do i=1,lons_lat
694 ilan=i+jlonf
695 grid_gr(ilan,G_rm +k-1)=grid_gr(ilan,G_rt +k-1)
696 enddo
697 enddo
698 do i=1,lons_lat
699 ilan=i+jlonf
700 grid_gr(ilan,G_qm)=grid_gr(ilan,G_zq)
701 enddo
702 enddo
703
704 return
705 end subroutine do_dynamics_gridn2m
706
707
708 subroutine do_dynamics_gridupdate(grid_gr,anl_gr_a_2,dt2,
709 & global_lats_a,lonsperlat)
710
711 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
712 real(kind=kind_evod) anl_gr_a_2(lonfx*lota,lats_dim_ext)
713 integer,intent(in):: global_lats_a(latg)
714 integer,intent(in):: lonsperlat(latg)
715 real, intent(in):: dt2
716
717 integer lan,lat,lon_dim,lons_lat,k,i
718 integer jlonf,ilan
719
720 do lan=1,lats_node_a
721 lat = global_lats_a(ipt_lats_node_a-1+lan)
722 lon_dim = lon_dims_a(lan)
723 lons_lat = lonsperlat(lat)
724 jlonf = (lan-1)*lonf
725 do k=1,levs
726 do i=1,lons_lat
727 ilan=i+jlonf
728 grid_gr(ilan,G_u +k-1)=grid_gr(ilan,G_uum+k-1)+
729 & anl_gr_a_2(i+(kau-2+k)*lon_dim,lan)*dt2
730 grid_gr(ilan,G_v +k-1)=grid_gr(ilan,G_vvm+k-1)+
731 & anl_gr_a_2(i+(kav-2+k)*lon_dim,lan)*dt2
732 grid_gr(ilan,G_t +k-1)=grid_gr(ilan,G_ttm+k-1)+
733 & anl_gr_a_2(i+(kat-2+k)*lon_dim,lan)*dt2
734 enddo
735 enddo
736 do k=1,levh
737 do i=1,lons_lat
738 ilan=i+jlonf
739 grid_gr(ilan,G_rt +k-1)=grid_gr(ilan,G_rm +k-1)+
740 & anl_gr_a_2(i+(kar-2+k)*lon_dim,lan)*dt2
741 enddo
742 enddo
743 do i=1,lons_lat
744 ilan=i+jlonf
745 grid_gr(ilan,G_zq)=grid_gr(ilan,G_qm)+
746 & anl_gr_a_2(i+(kaps-1)*lon_dim,lan)*dt2
747 enddo
748
749 enddo
750
751 return
752 end subroutine do_dynamics_gridupdate
753
754
755
756 subroutine do_dynamics_gridpdp(grid_gr,
757 & global_lats_a,lonsperlat)
758
759 use namelist_dynamics_def
760
761 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
762 integer,intent(in):: global_lats_a(latg)
763 integer,intent(in):: lonsperlat(latg)
764
765 real(kind=kind_grid) gtv (lonf,levs)
766 real(kind=kind_grid) gq (lonf)
767 real(kind=kind_grid) prsl(lonf,levs), dprs(lonf,levs)
768
769 integer lan,lat,lon_dim,lons_lat,k,i
770 integer jlonf,ilan
771
772 do lan=1,lats_node_a
773 lat = global_lats_a(ipt_lats_node_a-1+lan)
774 lon_dim = lon_dims_a(lan)
775 lons_lat = lonsperlat(lat)
776 jlonf = (lan-1)*lonf
777 do k=1,levs
778 do i=1,lons_lat
779 ilan=i+jlonf
780 gtv(i,k) = grid_gr(ilan,G_t +k-1)
781 enddo
782 enddo
783 do i=1,lons_lat
784 ilan=i+jlonf
785 gq(i) = grid_gr(ilan,G_zq)
786 enddo
787
788 if( gen_coord_hybrid ) then
789 call gch2press(lons_lat,lonf,gq, gtv, prsl, dprs)
790 else if( hybrid )then
791 call hyb2press(lons_lat,lonf,gq, prsl, dprs)
792 else
793 call sig2press(lons_lat,lonf,gq, prsl, dprs)
794 endif
795
796 do k=1,levs
797 do i=1,lons_lat
798 ilan=i+jlonf
799 grid_gr(ilan,g_p +k-1)=prsl(i,k)
800 grid_gr(ilan,g_dp +k-1)=dprs(i,k)
801 enddo
802 enddo
803
804 enddo
805
806 return
807 end subroutine do_dynamics_gridpdp
808
809
810
811 subroutine do_dynamics_griddpm(grid_gr,
812 & global_lats_a,lonsperlat)
813
814 use namelist_dynamics_def
815
816 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
817 integer,intent(in):: global_lats_a(latg)
818 integer,intent(in):: lonsperlat(latg)
819
820 real(kind=kind_grid) gtv (lonf,levs)
821 real(kind=kind_grid) gq (lonf)
822 real(kind=kind_grid) prsl(lonf,levs), dprs(lonf,levs)
823
824 integer lan,lat,lon_dim,lons_lat,k,i
825 integer jlonf,ilan
826
827 do lan=1,lats_node_a
828 lat = global_lats_a(ipt_lats_node_a-1+lan)
829 lon_dim = lon_dims_a(lan)
830 lons_lat = lonsperlat(lat)
831 jlonf = (lan-1)*lonf
832 do k=1,levs
833 do i=1,lons_lat
834 ilan=i+jlonf
835 gtv(i,k) = grid_gr(ilan,G_ttm+k-1)
836 enddo
837 enddo
838 do i=1,lons_lat
839 ilan=i+jlonf
840 gq(i) = grid_gr(ilan,G_qm)
841 enddo
842
843 if( gen_coord_hybrid ) then
844 call gch2press(lons_lat,lonf,gq, gtv, prsl, dprs)
845 else if( hybrid )then
846 call hyb2press(lons_lat,lonf,gq, prsl, dprs)
847 else
848 call sig2press(lons_lat,lonf,gq, prsl, dprs)
849 endif
850
851 do k=1,levs
852 do i=1,lons_lat
853 ilan=i+jlonf
854 grid_gr(ilan,g_dp +k-1)=dprs(i,k)
855 enddo
856 enddo
857
858 enddo
859
860 return
861 end subroutine do_dynamics_griddpm
862
863
864 subroutine do_dynamics_gridcheck(grid_gr,
865 & global_lats_a,lonsperlat,chr)
866
867 real(kind=kind_grid) grid_gr(lonf*lats_node_a_max,lotgr)
868 integer,intent(in):: global_lats_a(latg)
869 integer,intent(in):: lonsperlat(latg)
870 character*(*) chr
871
872 integer lan,lat,lons_lat,k
873
874 print *,' check: g_ttm g_tt g_t ',g_ttm,g_tt,g_t
875 do lan=1,lats_node_a
876 lat = global_lats_a(ipt_lats_node_a-1+lan)
877 lons_lat = lonsperlat(lat)
878 print *,' gridcheck: lan lat lons_lat ',lan,lat,lons_lat
879 do k=1,levs
880 print *,' check grid of ttm tt t at k=',k
881 call mymaxmin(grid_gr(1,g_ttm+k-1),lons_lat,lonf,1,chr)
882 call mymaxmin(grid_gr(1,g_tt +k-1),lons_lat,lonf,1,chr)
883 call mymaxmin(grid_gr(1,g_t +k-1),lons_lat,lonf,1,chr)
884 enddo
885 enddo
886
887 return
888 end subroutine do_dynamics_gridcheck
889
890 end module do_dynamics_mod
891