c @(#) lsdsr.f 1.2 (IDS) 1/19/95

C--- Southern Comm
CC      subroutine comm_south(win_d, upper, lower, max_iter, 
CC     &                      win_n, wr_south, wr_lower, co_lower, 
CC     &                      wrapd, width)  

        subroutine comm_south(win_n, w1, w2, w3, w4, 
     &                ii, jj, up, lo, upper, lower,
     &                max_iter)
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

      real      win_n(imp3,jmp3)
      real      w1(imp3,max_col_p3)
      real      w2(imp3,max_col_p3)
      real      w3(imp3,max_col_p3)
      real      w4(imp3,max_col_p3)
      integer   ii(imp3,max_col_p3)
      integer   jj(imp3,max_col_p3)
      integer   up, lo
      integer   upper, lower
      integer   max_iter(2)

      integer nx, nx0, ny, ny0, nynth, nysth, nxest, nxwst
      common /commvars/ nx,nx0,ny,ny0, nynth, nysth, nxest, nxwst

      integer mp_send_and_rcvint

      integer   wr_south, wr_lower, co_lower, wrapd, width
      integer c_range, c_upper, c_lower, t_lower
      integer wr_first
      integer i, j, k, tmp
      
      real      depart(imp3,max_col_p3)
      real      landing(imp3,max_col_p3)

        c_range = upper - lower + 1
        c_upper = upper
        c_lower = lower
        co_lower = lower

	k = 0
CC        width = c_range
        wr_first = 0
        wr_south = 0
        wrapd = 0
        wr_lower = -1

        do i = 1, imp3
CC           do j = 1, c_range
           do j = 1, c_range + 3
CC              depart(i,j) = win_d(i,j)
CC              win_n(i,j) = win_d(i,j)
              depart(i,j) = win_n(i,j)
           end do
        end do


        do while (k .lt. max_iter(2))
          call mp_sync()
          tmp = mp_send_and_rcvint(nysth, 0, t_lower,
     &                             nynth, 0, c_lower)
C          width = width + c_range

          if (c_lower .eq. 1) then
	    wr_south = 1		
            wr_first = 1
	    c_upper = jmp3
	    c_lower = t_lower
	    c_range = jmp3 - t_lower + 1
          endif

	  if (wr_south .eq. 1) then
	    wr_lower = t_lower
            wrapd = jmp3 + 1 - wr_lower
	  endif

	  if (wr_south .eq. 0) then
	    co_lower = t_lower
	  endif

	if (wr_first .ne. 1) then
	  c_upper = c_lower - 1
	  c_lower = t_lower
	  c_range = c_upper - c_lower + 1
	endif

	wr_first = 0

CC          do i = 1, imp3
CC           do j = width, 1, -1
CC              win_n(i, c_range + j) = win_n(i, j)
CC           end do 
CC          end do

CC          width = width + c_range

         call mp_sync()
	 call circ_winbuf( nysth, 0, landing, imp3, max_col_p3,
     &                     nynth, 0, depart, imp3, max_col_p3)
           
         do i = 1, imp3
           do j = 1, c_range
CC              win_n(i, j) = landing(i, j)
              depart(i, j) = landing(i, j)
           end do 
         end do
         
         call sel_bill_elems(w1, w2, w3, w4, landing, 
     &                       ii, jj, lower, upper, lo, up)


	 k = k + 1
       end do
      
      end 
C subroutine comm_south

C
C
C
C--- Northern Comm
CC      subroutine comm_north(win_d, upper, lower, max_iter, 
CC     &                      win_n, wr_north, width)  
        
        subroutine comm_north(win_n, w1, w2, w3, w4, 
     &                ii, jj, up, lo, upper, lower,
     &                max_iter)
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

      real      win_n(imp3,jmp3)
CC      real      win_d(imp3,max_col_p3)
      real      w1(imp3,max_col_p3)
      real      w2(imp3,max_col_p3)
      real      w3(imp3,max_col_p3)
      real      w4(imp3,max_col_p3)
      integer   ii(imp3,max_col_p3)
      integer   jj(imp3,max_col_p3)
      integer   up, lo
CC      integer   upper, lower
      integer   upper, lower
      integer   max_iter(2)
CC      integer   wr_north, width

      integer nx, nx0, ny, ny0, nynth, nysth, nxest, nxwst
      common /commvars/ nx,nx0,ny,ny0, nynth, nysth, nxest, nxwst
        
      integer mp_send_and_rcvint

      integer   wr_north, width
      integer c_range, c_upper, c_lower, t_upper
      integer wr_first
      integer i, j, k, tmp
      
      real      depart(imp3,max_col_p3)
      real      landing(imp3,max_col_p3)

        c_range = upper - lower + 1
        c_upper = upper
        c_lower = lower

	k = 0
C	width = 0
        wr_first = 0
        wr_north = 0 

        do i = 1, imp3
CC           do j = 1, c_range
           do j = 1, c_range+3
CC              depart(i,j) = win_d(i,j)
              depart(i,j) = win_n(i,j)
           end do
        end do

        do while (k .lt. max_iter(1))
           call mp_sync()
           tmp = mp_send_and_rcvint(nynth, 0, t_upper, 
     &                              nysth, 0, c_upper )

D           print *, "NewUp ", t_upper, " CurUp ", c_upper

          if (c_upper .eq. jmp3) then
	    wr_north = 1		
            wr_first = 1
	    c_upper = t_upper
	    c_lower = 1
	    c_range = t_upper - c_lower + 1
          endif

	if (wr_first .ne. 1) then
            c_lower = c_upper + 1
            c_upper = t_upper
            c_range = c_upper - c_lower + 1
	endif

	wr_first = 0

            call mp_sync()
            call circ_winbuf( nynth, 0, landing, imp3, max_col_p3,
     &                        nysth, 0, depart, imp3, max_col_p3)


            do i = 1, imp3
CC               do j = 1, c_range
               do j = 1, c_range+3
CC                  win_n(i, width + j) = landing(i, j)
                  depart(i, j) = landing(i, j)
               end do
            end do

            call sel_bill_elems(w1, w2, w3, w4, landing, 
     &                          ii, jj, lower, upper, lo, up)

CC            width = width + c_range
            k = k + 1
         end do

      end
C subroutine comm_north


C
C
C
C--- Northern Comm
      subroutine readjust_jj(jj, wr_south, wr_north, width,
     &                       wr_lower, co_lower, wrapd, njj)  
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

      integer   jj(imp3,max_col_p3)
      integer   wr_south, wr_north, width
      integer   wr_lower, co_lower, wrapd
      integer   njj(imp3,max_col_p3)

      integer i, j

        if ((wr_south .eq. 0) .and. 
     &      (wr_north .eq. 0)) then
          do i = 1, imp3
            do j = 1, max_col_p3
              njj(i, j) = jj(i, j) - co_lower + 1
            end do
          end do
        endif

        if (wr_south .eq. 1) then
          do i = 1, imp3
            do j = 1, max_col_p3
C               if (jj(i,j) .ge. wr_lower) then
               if (jj(i,j) .ge. wr_lower -3) then
                  njj(i,j) = jj(i, j) - wr_lower + 1
               else
                  njj(i,j) = jj(i,j) + wrapd
               endif
            end do
          end do
        endif
           
        if (wr_north .eq. 1) then
          do i = 1, imp3
            do j = 1, max_col_p3
               if (jj(i,j) .lt. co_lower) then
                  njj(i,j) = jj(i, j) + jmp3 - co_lower + 1
               else
                  njj(i,j) = jj(i,j) - co_lower + 1
               endif
            end do
          end do
        endif
      end




