File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\uvoedz.f
1 subroutine uvoedz(ulnod,vlnev,flnod,flnev,epse,epso,
2 x ls_node)
3
4 use gfs_dyn_resol_def
5 use gfs_dyn_layout1
6 use gfs_dyn_physcons, rerth => con_rerth
7 implicit none
8
9 real(kind=kind_evod) ulnod(len_trio_ls,2)
10 real(kind=kind_evod) vlnev(len_trie_ls,2)
11 real(kind=kind_evod) flnod(len_trio_ls,2)
12 real(kind=kind_evod) flnev(len_trie_ls,2)
13
14 real(kind=kind_evod) epse(len_trie_ls)
15 real(kind=kind_evod) epso(len_trio_ls)
16
17 integer ls_node(ls_dim,3)
18
19
20 integer l,locl,n
21
22 integer indev,indev1,indev2
23 integer indod,indod1,indod2
24 integer inddif
25
26 real(kind=kind_evod) rl,rn,rnp1
27
28 real(kind=kind_evod) cons0
29 real(kind=kind_evod) cons2
30
31 integer indlsev,jbasev
32 integer indlsod,jbasod
33
34 include 'function2'
35
36
37
38 = 0.d0
39 = 2.d0
40
41
42 do locl=1,ls_max_node
43 l=ls_node(locl,1)
44 jbasev=ls_node(locl,2)
45 jbasod=ls_node(locl,3)
46 indev1 = indlsev(L,L)
47 if (mod(L,2).eq.mod(jcap+1,2)) then
48 indev2 = indlsev(jcap+1,L) - 1
49 else
50 indev2 = indlsev(jcap ,L) - 1
51 endif
52 indod1 = indlsod(l+1,l)
53 inddif = indev1 - indod1
54
55 = l
56 rn = l+1
57 rnp1 = l+1+1
58 do indev = indev1 , indev2
59
60 (indev-inddif,1) =
61 x -rl * ulnod(indev-inddif,2)
62 x + rn * epse(indev+1 ) * vlnev(indev+1 ,1)
63 x - rnp1 * epso(indev-inddif) * vlnev(indev ,1)
64
65 (indev-inddif,2) =
66 x rl * ulnod(indev-inddif,1)
67 x + rn * epse(indev+1 ) * vlnev(indev+1 ,2)
68 x - rnp1 * epso(indev-inddif) * vlnev(indev ,2)
69
70 = rn + cons2
71 = rnp1 + cons2
72 end do
73
74 end do
75
76
77
78 do locl=1,ls_max_node
79 l=ls_node(locl,1)
80 jbasev=ls_node(locl,2)
81 jbasod=ls_node(locl,3)
82 indev1 = indlsev(L,L)
83 if (mod(L,2).eq.mod(jcap+1,2)) then
84 indev2 = indlsev(jcap-1,L)
85 else
86 indev2 = indlsev(jcap ,L)
87 endif
88 indod1 = indlsod(l+1,l)
89 inddif = indev1 - indod1
90
91 = l
92 rn = l
93 do indev = indev1 , indev2
94
95 (indev ,1) =
96 x -rl * vlnev(indev ,2)
97 x - rn * epso(indev-inddif) * ulnod(indev-inddif,1)
98
99 (indev ,2) =
100 x rl * vlnev(indev ,1)
101 x - rn * epso(indev-inddif) * ulnod(indev-inddif,2)
102
103 = rn + cons2
104 end do
105
106 end do
107
108
109
110 do locl=1,ls_max_node
111 l=ls_node(locl,1)
112 jbasev=ls_node(locl,2)
113 jbasod=ls_node(locl,3)
114 indev1 = indlsev(l,l) + 1
115 if (mod(L,2).eq.mod(jcap+1,2)) then
116 indev2 = indlsev(jcap-1,L)
117 else
118 indev2 = indlsev(jcap ,L)
119 endif
120 indod1 = indlsod(l+1,l)
121 inddif = indev1 - indod1
122
123 = l+2+1
124 do indev = indev1 , indev2
125
126 (indev ,1) =
127 x flnev(indev ,1)
128 x + rnp1 * epse(indev) * ulnod(indev-inddif,1)
129
130 (indev ,2) =
131 x flnev(indev ,2)
132 x + rnp1 * epse(indev) * ulnod(indev-inddif,2)
133
134 = rnp1 + cons2
135 end do
136
137 end do
138
139
140
141 do locl=1,ls_max_node
142 l=ls_node(locl,1)
143 jbasev=ls_node(locl,2)
144 jbasod=ls_node(locl,3)
145
146 if (mod(L,2).eq.mod(jcap+1,2)) then
147
148 (indlsev(jcap+1,l),1) = cons0
149 (indlsev(jcap+1,l),2) = cons0
150 else
151
152 (indlsod(jcap+1,l),1) = cons0
153 (indlsod(jcap+1,l),2) = cons0
154 endif
155
156
157 enddo
158
159
160
161
162 do locl=1,ls_max_node
163 l=ls_node(locl,1)
164 jbasev=ls_node(locl,2)
165 jbasod=ls_node(locl,3)
166 indev1 = indlsev(L,L)
167 indod1 = indlsod(L+1,L)
168 if (mod(L,2).eq.mod(jcap+1,2)) then
169 indev2 = indlsev(jcap+1,L)
170 indod2 = indlsod(jcap ,L)
171 else
172 indev2 = indlsev(jcap ,L)
173 indod2 = indlsod(jcap+1,L)
174 endif
175 do indev = indev1 , indev2
176 flnev(indev,1)=flnev(indev,1)/rerth
177 flnev(indev,2)=flnev(indev,2)/rerth
178 enddo
179
180 do indod = indod1 , indod2
181 flnod(indod,1)=flnod(indod,1)/rerth
182 flnod(indod,2)=flnod(indod,2)/rerth
183 enddo
184
185
186 enddo
187
188 return
189 end
190