File: C:\NOAA\NEMS_11731\src\atmos\gfs\phys\lats_shuff.f

1           subroutine setlats_r_ext(lats_nodes_r,lats_nodes_ext,
2          .                   global_lats_r,
3          &                   global_lats_ext,iprint,lonsperlat)
4     cc
5           use resol_def, ONLY: latr, jintmx, nypt
6           use layout1,   ONLY: nodes
7     !jw      use mpi_def,   ONLY: icolor, liope
8           implicit none
9     cc
10           integer              lats_nodes_r(nodes)
11     cc
12           integer              global_lats_r(latr)
13           integer              lats_nodes_ext(nodes)
14           integer        global_lats_ext(latr+2*jintmx+2*nypt*(nodes-1))
15     cc
16           integer              iprint,opt,ifin,nodesio
17     cc
18           integer              lonsperlat(latr)
19     cc
20           integer              ijk,jcount,jpt,lat,lats_sum,node,i,j
21           integer              ILATPE,ngrptg,ngrptl,ipe,irest,idp
22     cc
23     cc
24           OPT=1
25     !jw      if (liope) then
26     !jw         if (icolor.eq.2) then
27     !jw           nodesio=1
28     !jw         else
29     !jw           nodesio=nodes
30     !jw         endif
31     !jw      else
32              nodesio=nodes
33     !jw      endif
34     !!
35           do node=1,nodesio
36             if (nodesio.eq.1) then
37               lats_nodes_ext(node)=lats_nodes_r(node)+2*jintmx
38             else
39               if (node.eq.1.or.node.eq.nodesio) then
40                lats_nodes_ext(node)=lats_nodes_r(node)+jintmx+nypt
41               else
42                lats_nodes_ext(node)=lats_nodes_r(node)+2*nypt
43               endif
44             endif
45           enddo
46     cc........................................................
47     cc
48     cc
49           jpt=0
50           do node=1,nodesio
51            if (nodesio.eq.1) then
52             do i=1,jintmx
53               global_lats_ext(i)=global_lats_r(1)
54             enddo
55             do i=1,jintmx
56               global_lats_ext(jintmx+latr+i)=global_lats_r(latr)
57             enddo
58             do i=1,latr
59               global_lats_ext(i+jintmx)=global_lats_r(i)
60             enddo
61            else
62             do jcount=1,lats_nodes_r(node)
63              global_lats_ext(jpt+jintmx+jcount+2*nypt*(node-1))=
64          &               global_lats_r(jpt+jcount)
65             enddo
66             if (node.eq.1) then
67              do i=1,jintmx
68                global_lats_ext(i)=global_lats_r(1)
69              enddo
70              do i=1,nypt
71                global_lats_ext(jintmx+lats_nodes_r(node)+i)=
72          &               global_lats_r(lats_nodes_r(node))+i
73              enddo
74             elseif (node.eq.nodesio) then
75              do i=1,jintmx
76                global_lats_ext(latr+jintmx+2*nypt*(nodesio-1)+i)=
77          &                    global_lats_r(latr)
78              enddo
79              do i=nypt,1,-1
80                global_lats_ext(jpt+jintmx+2*nypt*(node-1)-i+1)=
81          &                    global_lats_r(jpt)-i+1
82              enddo
83             else
84              do i=nypt,1,-1
85                global_lats_ext(jpt+jintmx+2*nypt*(node-1)-i+1)=
86          &                    global_lats_r(jpt)-i+1
87              enddo
88              do i=1,nypt
89              global_lats_ext(jpt+jintmx+2*nypt*(node-1)+
90          &                    lats_nodes_r(node)+i)=
91          &              global_lats_r(jpt+lats_nodes_r(node))+i
92              enddo
93             endif
94            endif
95             jpt=jpt+lats_nodes_r(node)
96           enddo
97     cc
98     cc
99      
100           if ( iprint .ne. 1 ) return
101     cc
102           jpt=0
103           do node=1,nodesio
104              if ( lats_nodes_r(node) .gt. 0 ) then
105                 print 600
106                 lats_sum=0
107                 do jcount=1,lats_nodes_r(node)
108                    lats_sum=lats_sum + lonsperlat(global_lats_r(jpt+jcount))
109                    print 701, node-1,
110          x                    node,    lats_nodes_r(node),
111          x                    jpt+jcount, global_lats_r(jpt+jcount)
112     !selax                     lonsperlat(global_lats_r(jpt+jcount)),
113     !selax                    lats_sum
114                 enddo
115              endif
116              jpt=jpt+lats_nodes_r(node)
117           enddo
118     cc
119           print 600
120     cc
121       600 format ( ' ' )
122     cc
123       701 format (  'setlats  me=', i4,
124          x          '  lats_nodes_r(',  i4, ' )=', i4,
125          x          '  global_lats_r(', i4, ' )=', i4)
126       700 format (  'setlats  me=', i4,
127          x          '  lats_nodes_r(',  i4, ' )=', i4,
128          x          '  global_lats_r(', i4, ' )=', i4,
129          x          '  lonsperlat=', i5,
130          x          '  lats_sum=',   i6 )
131     cc
132           return
133           end
134     c
135           subroutine setlats_r_ext_shuff(lats_nodes_r,lats_nodes_ext,
136          .                   global_lats_r,
137          &                   global_lats_ext,iprint,lonsperlat)
138     cc
139           use resol_def, ONLY: latr, jintmx, nypt
140           use layout1,   ONLY: nodes
141     !jw      use mpi_def,   ONLY: icolor, liope
142           implicit none
143     cc
144           integer              lats_nodes_r(nodes)
145     cc
146           integer              global_lats_r(latr)
147           integer              lats_nodes_ext(nodes)
148           integer        global_lats_ext(latr+2*jintmx+2*nypt*(nodes-1))
149     cc
150           integer              iprint,opt,ifin,nodesio
151     cc
152           integer              lonsperlat(latr)
153     cc
154           integer              ijk,jcount,jpt,lat,lats_sum,node,i,j
155           integer              ILATPE,ngrptg,ngrptl,ipe,irest,idp
156     cc
157     cc
158           OPT=1
159     !jw      if (liope) then
160     !jw         if (icolor.eq.2) then
161     !jw           nodesio=1
162     !jw         else
163     !jw           nodesio=nodes
164     !jw         endif
165     !jw      else
166              nodesio=nodes
167     !jw      endif
168     !!
169           do node=1,nodesio
170             if (nodesio.eq.1) then
171               lats_nodes_ext(node)=lats_nodes_r(node)+2*jintmx
172             else
173               if (node.eq.1.or.node.eq.nodesio) then
174                lats_nodes_ext(node)=lats_nodes_r(node)+jintmx+nypt
175               else
176                lats_nodes_ext(node)=lats_nodes_r(node)+2*nypt
177               endif
178             endif
179           enddo
180     cc........................................................
181     cc
182     cc
183     c$$$      jpt=0
184     c$$$      do node=1,nodesio
185     c$$$       if (nodesio.eq.1) then
186     c$$$        do i=1,jintmx
187     c$$$          global_lats_ext(i)=global_lats_r(1)
188     c$$$        enddo
189     c$$$        do i=1,jintmx
190     c$$$          global_lats_ext(jintmx+latr+i)=global_lats_r(latr)
191     c$$$        enddo
192     c$$$        do i=1,latr
193     c$$$          global_lats_ext(i+jintmx)=global_lats_r(i)
194     c$$$        enddo
195     c$$$       else
196     c$$$        do jcount=1,lats_nodes_r(node)
197     c$$$         global_lats_ext(jpt+jintmx+jcount+2*nypt*(node-1))=
198     c$$$     &               global_lats_r(jpt+jcount)
199     c$$$        enddo
200     c$$$        if (node.eq.1) then
201     c$$$         do i=1,jintmx
202     c$$$           global_lats_ext(i)=global_lats_r(1)
203     c$$$         enddo
204     c$$$         do i=1,nypt
205     c$$$           global_lats_ext(jintmx+lats_nodes_r(node)+i)=
206     c$$$     &               global_lats_r(lats_nodes_r(node))+i
207     c$$$         enddo
208     c$$$        elseif (node.eq.nodesio) then
209     c$$$         do i=1,jintmx
210     c$$$           global_lats_ext(latr+jintmx+2*nypt*(nodesio-1)+i)=
211     c$$$     &                    global_lats_r(latr)
212     c$$$         enddo
213     c$$$         do i=nypt,1,-1
214     c$$$           global_lats_ext(jpt+jintmx+2*nypt*(node-1)-i+1)=
215     c$$$     &                    global_lats_r(jpt)-i+1
216     c$$$         enddo
217     c$$$        else
218     c$$$         do i=nypt,1,-1
219     c$$$           global_lats_ext(jpt+jintmx+2*nypt*(node-1)-i+1)=
220     c$$$     &                    global_lats_r(jpt)-i+1
221     c$$$         enddo
222     c$$$         do i=1,nypt
223     c$$$         global_lats_ext(jpt+jintmx+2*nypt*(node-1)+
224     c$$$     &                    lats_nodes_r(node)+i)=
225     c$$$     &              global_lats_r(jpt+lats_nodes_r(node))+i
226     c$$$         enddo
227     c$$$        endif
228     c$$$       endif
229     c$$$        jpt=jpt+lats_nodes_r(node)
230     c$$$      enddo
231     cc
232     cc
233      
234           if ( iprint .ne. 1 ) return
235     cc
236           jpt=0
237           do node=1,nodesio
238              if ( lats_nodes_r(node) .gt. 0 ) then
239                 print 600
240                 lats_sum=0
241                 do jcount=1,lats_nodes_r(node)
242                    lats_sum=lats_sum + lonsperlat(global_lats_r(jpt+jcount))
243                    print 701, node-1,
244          x                    node,    lats_nodes_r(node),
245          x                    jpt+jcount, global_lats_r(jpt+jcount)
246     !selax                     lonsperlat(global_lats_r(jpt+jcount)),
247     !selax                    lats_sum
248                 enddo
249              endif
250              jpt=jpt+lats_nodes_r(node)
251           enddo
252     cc
253           print 600
254     cc
255       600 format ( ' ' )
256     cc
257       701 format (  'setlats  me=', i4,
258          x          '  lats_nodes_r(',  i4, ' )=', i4,
259          x          '  global_lats_r(', i4, ' )=', i4)
260       700 format (  'setlats  me=', i4,
261          x          '  lats_nodes_r(',  i4, ' )=', i4,
262          x          '  global_lats_r(', i4, ' )=', i4,
263          x          '  lonsperlat=', i5,
264          x          '  lats_sum=',   i6 )
265     cc
266           return
267           end
268