File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\grid_to_spect.f
1 subroutine grid_to_spect
2 & (trie_ls,trio_ls,
3 & anl_gr_a_1,anl_gr_a_2,
4 & ls_node,ls_nodes,max_ls_nodes,
5 & lats_nodes_a,global_lats_a,lonsperlat,
6 & epse,epso,plnew_a,plnow_a)
7
8
9
10 use gfs_dyn_resol_def
11 use gfs_dyn_layout1
12 use gfs_dyn_gg_def
13 use gfs_dyn_vert_def
14 use gfs_dyn_date_def
15 use namelist_dynamics_def
16 use gfs_dyn_coordinate_def
17 use gfs_dyn_tracer_const
18 use gfs_dyn_physcons, grav => con_g
19 implicit none
20
21
22
23
24 real(kind=kind_evod) trie_ls(len_trie_ls,2,lotls)
25 real(kind=kind_evod) trio_ls(len_trio_ls,2,lotls)
26
27 real(kind=kind_evod) anl_gr_a_1(lonfx*lota,lats_dim_a)
28 real(kind=kind_evod) anl_gr_a_2(lonfx*lota,lats_dim_a)
29
30 integer ls_node(ls_dim,3)
31 integer ls_nodes(ls_dim,nodes)
32 integer max_ls_nodes(nodes)
33 integer lats_nodes_a(nodes)
34 integer global_lats_a(latg)
35 integer lonsperlat(latg)
36 integer dimg
37
38 real(kind=kind_evod) epse(len_trie_ls)
39 real(kind=kind_evod) epso(len_trio_ls)
40
41 real(kind=kind_evod) rcs2
42
43 real(kind=kind_evod) plnew_a(len_trie_ls,latg2)
44 real(kind=kind_evod) plnow_a(len_trio_ls,latg2)
45
46 integer i,j,k, nn, nnl
47 integer l,lan,lat
48 integer lon_dim,lons_lat
49
50 integer locl,n
51 integer indev
52 integer indod
53 integer indev1,indev2
54 integer indod1,indod2
55 INTEGER INDLSEV,JBASEV
56 INTEGER INDLSOD,JBASOD
57
58 logical lslag
59
60
61
62 real*8 rtc ,timer1,timer2
63
64
65
66
67
68
69
70
71
72 INCLUDE 'function2'
73
74
75
76 = .false.
77
78
79 do lan=1,lats_node_a
80 lon_dim = lon_dims_a(lan)
81 lat = global_lats_a(ipt_lats_node_a-1+lan)
82 lons_lat = lonsperlat(lat)
83 rcs2 = rcs2_a(min(lat,latg-lat+1))
84 do k=1,levs
85 do i=1,lons_lat
86 anl_gr_a_2(i+(kau+k-2)*lon_dim,lan) =
87 & anl_gr_a_2(i+(kau+k-2)*lon_dim,lan) * rcs2
88 anl_gr_a_2(i+(kav+k-2)*lon_dim,lan) =
89 & anl_gr_a_2(i+(kav+k-2)*lon_dim,lan) * rcs2
90 enddo
91 enddo
92 enddo
93
94 do lan=1,lats_node_a
95
96 = lon_dims_a(lan)
97
98 = global_lats_a(ipt_lats_node_a-1+lan)
99 lons_lat = lonsperlat(lat)
100
101 call grid2four_thread(anl_gr_a_2(1,lan),anl_gr_a_1(1,lan),
102 & lon_dim,lons_lat,lonfx,lota)
103
104 enddo
105
106 =0
107 call four2fln(lslag,lats_dim_a,lota,lota,anl_gr_a_1,
108 x ls_nodes,max_ls_nodes,
109 x lats_nodes_a,global_lats_a,lon_dims_a,
110 x lats_node_a,ipt_lats_node_a,dimg,
111 x lat1s_a,lonfx,latg,latg2,
112 x trie_ls(1,1,P_w), trio_ls(1,1,P_w),
113 x plnew_a, plnow_a,
114 x ls_node)
115
116
117
118
119
120 do k=1,levs
121 call uveodz(trie_ls(1,1,P_w +k-1), trio_ls(1,1,P_x +k-1),
122 x trie_ls(1,1,P_uln+k-1), trio_ls(1,1,P_vln+k-1),
123 x epse,epso,ls_node)
124
125 call uvoedz(trio_ls(1,1,P_w +k-1), trie_ls(1,1,P_x +k-1),
126 x trio_ls(1,1,P_uln+k-1), trie_ls(1,1,P_vln+k-1),
127 x epse,epso,ls_node)
128 enddo
129
130
131
132
133 do k=1,levs
134 do i=1,len_trie_ls
135 trie_ls(i,1,P_x +k-1)= trie_ls(i,1,P_uln +k-1)
136 trie_ls(i,2,P_x +k-1)= trie_ls(i,2,P_uln +k-1)
137 trie_ls(i,1,P_w +k-1)= trie_ls(i,1,P_vln +k-1)
138 trie_ls(i,2,P_w +k-1)= trie_ls(i,2,P_vln +k-1)
139 enddo
140 do i=1,len_trio_ls
141 trio_ls(i,1,P_x +k-1)= trio_ls(i,1,P_uln +k-1)
142 trio_ls(i,2,P_x +k-1)= trio_ls(i,2,P_uln +k-1)
143 trio_ls(i,1,P_w +k-1)= trio_ls(i,1,P_vln +k-1)
144 trio_ls(i,2,P_w +k-1)= trio_ls(i,2,P_vln +k-1)
145 enddo
146 enddo
147
148
149
150 return
151 end
152