c %Z% %M% %I% (IDS) %G%

C+
C*
C*   This file contains the following routines in the nodal part 
C*   of the host-node program :
C*   
C*   1) subroutine comm_south - Gathers elements from southern nodes.
C*   2) subroutine comm_north - Gathers elements from northern nodes.
C*   3) subroutine readjust_jj - Converts global jj's to local jj's 
C*                              
C-

C+ 
C  Subroutine - comm_south
C  This routine first copies the partition into a larger buffer 
C  which hold a segment of the original wind component. It then          
C  iterates for the number of southern hops as follows,         
C         1) It fetches the lower bound of the to be received partition
C         2) It verifies if the to be fetched partition is "wrapped"
C            around the globe, i.e. crosses the south pole.          
C         3) If the there is a pole crossover, then the book-keeping
C            is done differently. Else, update the new upper bound to
C            to be one less than current lower bound. Current lower
C            bound changes to the newly received lower bound. 
C         4) It then moves the data in the segment by the width
C            of the to be received partition.
C         5) It receives new partition.
C         6) It copies new partition into segment.
C
C         When there is a pole crossover, the lower bound of the
C         wrapped region is also noted, else the lower bound of
C         of the segment alone needs to be known. Additionally the
C         the width of the wrapped region is also noted in addition
C         to the width of the segment.  These are needed for correct
C         conversion to local indices.  Please see SCCS 694 for 
C         additional information.
C
C  Inputs : 
C
C           win_d         - decomposed wind component
C           lower, upper  - partition bounds on each node
C           max_iter      - number of hops in each direction
C  
C  Outputs : 
C           win_n         - buffer to hold the segment
C           wr_south      - whether a pole cross-over occured in the
C                           south direction.
C           wr_lower      - lower bound of the wrapped region
C           co_lower      - lower bound of the non-wrapped region
C           wrapd         - width of wrapped region
C           width         - width of segment
C-

      subroutine comm_south(win_d, upper, lower, max_iter, 
     &                      win_n, wr_south, wr_lower, co_lower, 
     &                      wrapd, width)  
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

      real      win_d(imp3,max_col_p3)
      integer   upper, lower
      integer   max_iter(2)
      real      win_n(imp3,jmp3)
      integer   wr_south, wr_lower, co_lower, wrapd, width

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

C
C     Timing Code.
C
         real*8 gcbtime, lcbtime, cabtime, llitime, loitime,
     &          brtime, cstime, cntime, reatime, fbtime, intime
         common /ntime/ cabtime, gcbtime, lcbtime, llitime, 
     &          loitime, brtime, cstime, cntime, reatime, fbtime,
     &          intime


CT      Function prototypes
        integer mp_send_and_rcvint
        integer mp_timer_clear
        integer mp_timer_start
        integer mp_timer_stop
        real*8 mp_elapsed_time
        real*8 mp_busy_time
CT

C
C     c_range - Width of current partition 
C     c_upper - upper bound of the partition
C     c_lower - lower bound "   "      "
C     t_lower - lower bound "  to be received partition
C     wr_first - is the first time, pole is crossed
C
      integer c_range, c_upper, c_lower, t_lower
      integer wr_first
      integer i, j, k, tmp        !counters and temporary variables
      
C
C     Buffers for sending and receiving
C
      real      depart(imp3,max_col_p3)
      real      landing(imp3,max_col_p3)


D      print *, "In subrt. comm_south"
CT    Timing Code for measuring comm. south
	tmp = mp_timer_clear(7)
        if (tmp .eq. -1) then
           print *, 'Failure in clearing timer'
           stop
        end if
        tmp = mp_timer_start(7)
        if (tmp .eq. -1) then
           print *, 'Failure in starting timer'
           stop
        end if

	tmp = mp_timer_clear(8)
        if (tmp .eq. -1) then
           print *, 'Failure in clearing timer'
           stop
        end if
CT    Timing Code 

C
C     Initialization of variables.
C
        c_range = upper - lower + 1
        c_upper = upper
        c_lower = lower
        co_lower = lower

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

C
C     Set up the segment and sending buffers
C
        do i = 1, imp3
           do j = 1, c_range
              depart(i,j) = win_d(i,j)
              win_n(i,j) = win_d(i,j)
           end do
        end do


C
C     For the number of southern hops.
C
        do while (k .lt. max_iter(2))
          call mp_sync()

          tmp = mp_timer_start(8)
          if (tmp .eq. -1) then
             print *, 'Failure in starting timer'
             stop
          end if

C
C     Send lower bound to northern neighbor and receive 
C                    from southern 
C
          tmp = mp_send_and_rcvint(nysth, 0, t_lower,
     &                             nynth, 0, c_lower)

CT    Timing Code 
        tmp = mp_timer_stop(8)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if

C          width = width + c_range      ! not used

C
C     If there is a pole crossover (c_lower is 1 the first time)
C
          if (c_lower .eq. 1) then
	    wr_south = 1	    ! pole crossover ocurred
            wr_first = 1            ! first time 
	    c_upper = jmp3          ! upper bound is jmp3 now (slgcm.slgprm)
	    c_lower = t_lower       ! lower bound is new lower bound
	    c_range = jmp3 - t_lower + 1  ! update range
          endif

C
C     If a pole crossover occurred
C
	  if (wr_south .eq. 1) then
	    wr_lower = t_lower           ! Record lower bound for wrap region
            wrapd = jmp3 + 1 - wr_lower  ! and the width
	  endif

	  if (wr_south .eq. 0) then      ! No Pole crossover
	    co_lower = t_lower           ! Record lower bound for segment
	  endif

C
C     If no pole crossover or not the first pole crossover, the 
C     current upper bound is  the previous lower bound less one.
C
	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              ! reset first time pole crossover

C
C     shift the data in the segment to make place for new partition
C
          do i = 1, imp3
           do j = width, 1, -1
              win_n(i, c_range + j) = win_n(i, j)
           end do 
          end do

          width = width + c_range     ! update width of segment

         call mp_sync()

CT    Timing Code for subraction of comm.
D	tmp = mp_timer_clear(8)
D        if (tmp .eq. -1) then
D           print *, 'Failure in clearing timer'
D           stop
D        end if
        tmp = mp_timer_start(8)
        if (tmp .eq. -1) then
           print *, 'Failure in starting timer'
           stop
        end if
CT    Timing Code 

C
C     Circulate or shift the partitions of wind components
C
	 call circ_winbuf( nysth, 0, landing, imp3, max_col_p3,
     &                     nynth, 0, depart, imp3, max_col_p3)

CT    Timing Code 
        tmp = mp_timer_stop(8)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if
C
C      Subtract time for communication
C
D        cstime = cstime - mp_busy_time(8) 
CT    Timing Code 
           
C
C     Copy the newly received partition to the segment. 
C     Copy the receiving buffer to the sending buffer.
C
         do i = 1, imp3
           do j = 1, c_range
              win_n(i, j) = landing(i, j)
              depart(i, j) = landing(i, j)
           end do 
         end do

	 k = k + 1                          ! update no. of hops
       end do
      
CT    Timing Code 
        tmp = mp_timer_stop(7)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if
C
C       Accumulate times for measuring comm. south
C
        cstime = cstime + mp_busy_time(7) 
C
C      Subtract time for communication
C
        cstime = cstime - mp_busy_time(8) 
CT    Timing Code 

      end 
C subroutine comm_south


C+ 
C  Subroutine - comm_north
C  This routine first copies the partition into the send buffer.
C  It then iterates for the number of northern hops as follows,         
C         1) It fetches the upper bound of the to be received partition
C         2) It verifies if the to be fetched partition is "wrapped"
C            around the globe, i.e. crosses the northern pole.          
C         3) If the there is a pole crossover, then the book-keeping
C            is done differently. Else, update the new lower bound to
C            to be one more than current upper bound. Current upper
C            bound changes to the newly received upper bound. 
C         4) It receives new partition from the northern neigbor.
C         6) It copies new partition into segment at the northern end.
C         7) Update width of segment.
C
C         When there is a pole crossover for the first time, the
C         lower bound is set to '1' and upper bound is set to newly
C         received bound.  Please see SCCS 694 for 
C         additional information.
C
C  Inputs : 
C
C           win_d         - decomposed wind component
C           lower, upper  - partition bounds on each node
C           max_iter      - number of hops in each direction
C  
C  Outputs : 
C           win_n         - buffer to hold the segment
C           wr_north      - whether a pole cross-over occured in the
C                           northern direction.
C           width         - width of segment
C-
      subroutine comm_north(win_d, upper, lower, max_iter, 
     &                      win_n, wr_north, width)  
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

      real      win_d(imp3,max_col_p3)
      integer   upper, lower
      integer   max_iter(2)
      real      win_n(imp3,jmp3)
      integer   wr_north, width


C
C     Layout commons
C      
      integer nx, nx0, ny, ny0, nynth, nysth, nxest, nxwst
      common /commvars/ nx,nx0,ny,ny0, nynth, nysth, nxest, nxwst
        
C
C     Timing Code.
C
          real*8 gcbtime, lcbtime, cabtime, llitime, loitime,
     &          brtime, cstime, cntime, reatime, fbtime, intime
         common /ntime/ cabtime, gcbtime, lcbtime, llitime, 
     &          loitime, brtime, cstime, cntime, reatime, fbtime,
     &          intime


CT      Function prototypes
        integer mp_send_and_rcvint
        integer mp_timer_clear
        integer mp_timer_start
        integer mp_timer_stop
        real*8 mp_elapsed_time
        real*8 mp_busy_time
CT

C
C     c_range - Width of current partition 
C     c_upper - upper bound of the partition
C     c_lower - lower bound "   "      "
C     t_lower - lower bound "  to be received partition
C     wr_first - is the first time, pole is crossed
C
      integer c_range, c_upper, c_lower, t_upper
      integer wr_first
      integer i, j, k, tmp      !counters and temporary variables
      
C
C     Buffers for sending and receiving
C
      real      depart(imp3,max_col_p3)
      real      landing(imp3,max_col_p3)

D      print *, "In subrt. comm_north"
CT    Timing Code for measuring comm. north
	tmp = mp_timer_clear(7)
        if (tmp .eq. -1) then
           print *, 'Failure in clearing timer'
           stop
        end if
        tmp = mp_timer_start(7)
        if (tmp .eq. -1) then
           print *, 'Failure in starting timer'
           stop
        end if

	tmp = mp_timer_clear(8)
        if (tmp .eq. -1) then
           print *, 'Failure in clearing timer'
           stop
        end if
CT    Timing Code 

C
C     Initialization of variables.
C
        c_range = upper - lower + 1
        c_upper = upper
        c_lower = lower

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

C
C     Set up the sending buffer
C
        do i = 1, imp3
           do j = 1, c_range
              depart(i,j) = win_d(i,j)
           end do
        end do

C
C     For the number of northern hops.
C
        do while (k .lt. max_iter(1))
           call mp_sync()

           tmp = mp_timer_start(8)
           if (tmp .eq. -1) then
              print *, 'Failure in starting timer'
              stop
           end if

C
C     Send lower bound to southern neighbor and receive 
C                    from northern 
C
           tmp = mp_send_and_rcvint(nynth, 0, t_upper, 
     &                              nysth, 0, c_upper )

           tmp = mp_timer_stop(8)
           if (tmp .eq. -1) then
              print *, 'Failure in stopping timer'
              stop
           end if

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

C
C     If there is a pole crossover (c_upper equals jmp3 the first time)
C
          if (c_upper .eq. jmp3) then
	    wr_north = 1		! pole crossover ocurred
            wr_first = 1                ! first time
	    c_upper = t_upper           ! update upper bound
	    c_lower = 1                 ! set lower bound to 1
	    c_range = t_upper - c_lower + 1  ! update range
          endif

C
C     If no pole crossover or not the first pole crossover, the 
C     current lower bound is the previous lower bound plus one.
C
	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                     ! reset first time

            call mp_sync()

CT    Timing Code for subraction of comm.
D	tmp = mp_timer_clear(8)
D        if (tmp .eq. -1) then
D           print *, 'Failure in clearing timer'
D           stop
D        end if
        tmp = mp_timer_start(8)
        if (tmp .eq. -1) then
           print *, 'Failure in starting timer'
           stop
        end if
CT    Timing Code 

C
C     Circulate or shift the partitions of wind components
C
            call circ_winbuf( nynth, 0, landing, imp3, max_col_p3,
     &                        nysth, 0, depart, imp3, max_col_p3)

CT    Timing Code 
        tmp = mp_timer_stop(8)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if
C
C      Subtract time for communication
C
D        cntime = cntime - mp_busy_time(8) 
CT    Timing Code 

C
C     Copy the newly received partition to the segment at northern edge.
C     Copy the receiving buffer to the sending buffer.
C
            do i = 1, imp3
               do j = 1, c_range
                  win_n(i, width + j) = landing(i, j)
                  depart(i, j) = landing(i, j)
               end do
            end do

            width = width + c_range       ! update width of segment
            k = k + 1                     ! update no. of hops
         end do

CT    Timing Code 
        tmp = mp_timer_stop(7)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if
C
C       Accumulate times for measuring comm. north
C
        cntime = cntime + mp_busy_time(7) 
C
C      Subtract time for communication
C
        cntime = cntime - mp_busy_time(8) 
CT    Timing Code 

      end
C subroutine comm_north


C+ 
C  Subroutine - readjust_jj
C  This routine first ascertains if there was a "wrap" in either 
C  of the directions.  According to that there are 3 cases.
C     1) No Wrap
C     2) Southern Wrap (South pole crossover)
C     3) Northern Wrap (North pole crossover)
C     
C  If there is no wrap, then the local index 
C                          = global index - lower bound of segment + 1
C  If there is a southern wrap, it further decides, if the index is
C  falls within the wrapped part or not. If it is in the wrapped part,
C  local index = global index - lower bound of wrapped region + 1
C  Else it is global index + width of wrapped part.
C
C  If there is a northern wrap, it further decides, if the index is
C  falls within the wrapped part or not. If it is in the wrapped part,
C  local index = global index + width of non-wrapped part
C     Else it is global index - lower bound of non-wrapped part +1
C
C
C  Inputs : 
C
C           jj                  - global indices
C           wr_south, wr_north  - did a wrap occur ?
C                                 0 - No ; 1 - Yes
C                                 
C           width         - width of segment
C           wr_lower      - lower bound of wrapped part (southern wrap)
C           co_lower      - lower bound of segment
C           wrapd         - width of wrapped part (southern wrap)
C
C  Outputs : 
C           njj           - local indices
C-
      subroutine readjust_jj(jj, wr_south, wr_north, width,
     &                       wr_lower, co_lower, wrapd, njj)  
        
      include "slgcm.slgprm"
      include "slgcm.mp"

      implicit none

         real*8 gcbtime, lcbtime, cabtime, llitime, loitime,
     &          brtime, cstime, cntime, reatime, fbtime, intime
         common /ntime/ cabtime, gcbtime, lcbtime, llitime, 
     &          loitime, brtime, cstime, cntime, reatime, fbtime,
     &          intime

      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, tmp

CT      Function prototypes
        integer mp_timer_clear
        integer mp_timer_start
        integer mp_timer_stop
        real*8 mp_elapsed_time
        real*8 mp_busy_time
CT

D      print *, "In subrt. read_jj"
CT    Timing Code for measuring calcn. of local indices
	tmp = mp_timer_clear(7)
        if (tmp .eq. -1) then
           print *, 'Failure in clearing timer'
           stop
        end if
        tmp = mp_timer_start(7)
        if (tmp .eq. -1) then
           print *, 'Failure in starting timer'
           stop
        end if
CT    Timing Code 

C
C     If no wrapped region, 
C

        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

C
C     If wrapped over the south pole
C
        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 in wrapped part
               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
           
C
C       If wrapped over North pole
C
        if (wr_north .eq. 1) then
          do i = 1, imp3
            do j = 1, max_col_p3
               if (jj(i,j) .lt. co_lower) then            ! if in wrapped part

C                 jmp3 - co_lower + 1 is width of non-wrapped part
                  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

CT    Timing Code 
        tmp = mp_timer_stop(7)
        if (tmp .eq. -1) then
           print *, 'Failure in stopping timer'
           stop
        end if
C
C      Accumulate times for calculating local indices
C
        reatime = reatime + mp_busy_time(7) 
CT    Timing Code 

      end




