C program test_bicubic
        Program test_bicubic

          include "slgcm.slgprm"
          include "slgcm.mp"

          implicit none

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

          integer dlower(6), dupper(6), lindex, comm_s
          real dwin(4,30)
          common /dvars/ dlower, dupper, lindex, comm_s, dwin

C          integer dmax_iter(10)
          integer dny0(10), i, j, k
          integer djj(imp3,jmp3), jj(imp3, max_col_p3)
C          integer njj(imp3, max_col_p3)
          integer dii(imp3,jmp3), ii(imp3, max_col_p3)

          real      win_d(imp3,max_col_p3), wou_d(imp3, max_col_p3)
          integer   upper, lower
          integer   max_iter(2)
C          real      win_n(imp3,jmp3)
C          integer   wr_south, wr_lower, co_lower, width, wrapd
C          integer   wr_north
          integer   range, ja, jb
          real      delx(imp3,max_col_p3), dely(imp3, max_col_p3)
          real      add, ddelx(imp3,jmp3), ddely(imp3, jmp3)
          real      dwou(imp3,jm)
          
 100      format( 6I4)
 101      format( 2(5I4))
 102      format( 4I4)
 103      format ( "Ny0", I4, "South Wrap", I4, "North Wrap", I4)
 104      format ( "Wdth", I4, "Wr Lr", I4, "Co Lr", I4,  "Wrd", I4 )     
 105      format ( "JJ" //, 4(I4))
 106      format ( "NJJ" //, 4(I4))

 107      format ( I4, I4, F16.8)

          open (unit = 10, file = 'dloup.dat', status = 'old' )
          read (10, 100) (dlower(i), i = 1, 6)
          read (10, 100) (dupper(i), i = 1, 6)
          close(10)

          open (unit = 11, file = 'dtnorth.dat', status = 'old' )
          read (11, 101) (dny0(i), i = 1, 6)
          close(11)

          open (unit = 12, file = 'djj.dat', status = 'old' )
          read (12, 102) ((djj(i,j), i = 1, imp3), j = 1, jmp3)
          close(12)

         open (unit = 13, file = 'debug1.out', status = 'scratch' )
         close(13)
         open (unit = 13, file = 'debug1.out', status = 'new' )

          ja = 2
          jb = jm

          do i = 1, imp3
             do ny0 = 0, 5
                range = dupper(ny0 +1) - dlower(ny0 +1)
                do j = 0, range
                   dwin(i, dlower(ny0 +1) + j) = ny0
                end do
             end do
          end do

          do i = 1, imp3
             add = 0
             do j = 1, jmp3
                add = add + 0.1
                if (add .eq. 1.0) add = 0.1
                ddelx(i,j) = add
                ddely(i,j) = djj(i,j) + add
                dii(i,j) = 2
                if (dii(i,j) .eq. 1) dii(i,j) = imp1
             end do
          end do

C1          do i = 1, 6
C1             ny0 = dny0(i)
C1             upper = dupper(ny0 + 1)
C1             lower = dlower(ny0 + 1)
C1             range = upper - lower + 1
C1
C1             do k = 1, imp3
C1                do j = 1, range
C1                   jj(k, j)   = djj(k, lower + j -1)
C1                   ii(k,j)    = dii(k, lower + j -1)
C1                   win_d(k,j) = dwin(k, lower + j -1)
C1                   delx(k,j)  = ddelx(k, lower + j -1)
C1                   dely(k,j)  = ddely(k, lower + j -1)
C1                end do
C1             end do
C1
C1             call  set_lsd_commons(nx,nx0,ny,ny0, nynth, 
C1     *                             nysth, nxest, nxwst)
C1
C1             call locubit(win_d, delx, dely, wou_d, ii,
C1     &                     jj, lower, upper, ja, jb)
C1          write (13, 103) ny0, wr_south, wr_north
C1          write (13, 104) width, wr_lower, co_lower, wrapd 
C1          write (13, 105) ((jj(k,j), k = 1, imp3), j = 1, range)
C1          write (13, 106) ((njj(k,j), k = 1, imp3), j = 1, range)
C1
C1          end do

          do j=ja, jb
             do i=1,imp3
C1                print 108, i, j, dii(i,j), djj(i,j), 
C1     &                  ddelx(i,j), ddely(i,j),
C1     &               dwin(dii(i,j)  ,djj(i,j)+2), 
C1     &               dwin(dii(i,j)  ,djj(i,j)+3),
C1     &               dwin(dii(i,j)  ,djj(i,j)+1),
C1     &               dwin(dii(i,j)  ,djj(i,j)+4),
C1     &               dwin(dii(i,j)+1,djj(i,j)+2),
C1     &               dwin(dii(i,j)+1,djj(i,j)+3),
C1     &               dwin(dii(i,j)+1,djj(i,j)+1),
C1     &               dwin(dii(i,j)+1,djj(i,j)+4),
C1     &               dwin(dii(i,j)-1,djj(i,j)+2),
C1     &               dwin(dii(i,j)-1,djj(i,j)+3),
C1     &               dwin(dii(i,j)-1,djj(i,j)+1),
C1     &               dwin(dii(i,j)-1,djj(i,j)+4),
C1     &               dwin(dii(i,j)+2,djj(i,j)+2),
C1     &               dwin(dii(i,j)+2,djj(i,j)+3),
C1     &               dwin(dii(i,j)+2,djj(i,j)+1),
C1     &               dwin(dii(i,j)+2,djj(i,j)+4)
                       
                call  cubit( ddelx(i,j),ddely(i,j),
     &               dwin(dii(i,j)  ,djj(i,j)+2), 
     &               dwin(dii(i,j)  ,djj(i,j)+3),
     &               dwin(dii(i,j)  ,djj(i,j)+1),
     &               dwin(dii(i,j)  ,djj(i,j)+4),
     &               dwin(dii(i,j)+1,djj(i,j)+2),
     &               dwin(dii(i,j)+1,djj(i,j)+3),
     &               dwin(dii(i,j)+1,djj(i,j)+1),
     &               dwin(dii(i,j)+1,djj(i,j)+4),
     &               dwin(dii(i,j)-1,djj(i,j)+2),
     &               dwin(dii(i,j)-1,djj(i,j)+3),
     &               dwin(dii(i,j)-1,djj(i,j)+1),
     &               dwin(dii(i,j)-1,djj(i,j)+4),
     &               dwin(dii(i,j)+2,djj(i,j)+2),
     &               dwin(dii(i,j)+2,djj(i,j)+3),
     &               dwin(dii(i,j)+2,djj(i,j)+1),
     &               dwin(dii(i,j)+2,djj(i,j)+4), dwou(i,j))

             end do
          end do

c          write (13, 107) ((dwou(k,j), k = 1, imp3), j = 1, jm)
           do j = 1, jm
              do k = 1, imp3
                 write (13,107), k, j, dwou(k,j)
              end do
           end do

 108      format ( "I", I4, " J", I4, " II", I4, " JJ", I4 //, 
     &             "DELX", F16.8, " DELY", F16.8 //,
     &             "W1", F16.8, " W2", F16.8, " W3", F16.8, 
     &             " W4", F16.8 //,
     &             "W5", F16.8, " W6", F16.8, " W7", F16.8, 
     &             " W8", F16.8 //,
     &             "W9", F16.8, " W10", F16.8, " W11", F16.8, 
     &             " W12", F16.8 //,
     &             "W13", F16.8, " W14", F16.8, " W15", F16.8, 
     &             " W16", F16.8)


          close(13)
        end


        subroutine set_lsd_commons(nx,nx0,ny,ny0, nynth, 
     *                             nysth, nxest, nxwst)
        
          implicit none
          
          include "slgcm.mp"

          integer nx,
     &            nx0,
     &            ny,
     &            ny0,
     &            nynth,
     &            nysth,
     &            nxest,
     &            nxwst

          nx = 1
          nx0 = 0
D          ny  = CMMD_partition_size()
D          ny0 = CMMD_self_address()
          ny  = 6
          nynth  = mod( ny0 + 1, ny )
          if (ny0 .eq. 0) then
            nysth = 5
          else
             nysth  = mod( ny0 - 1, ny )
          endif
          
C1          if (nysth .eq. -1) then
C1            nysth = nysth + ny
C1          endif

          nxest = -1
          nxwst = -1
          print 201, ny0, nynth, nysth
 201      format("Node : ", I4, " SRC : ", I4, " DEST ", I4 )

        end


      function mp_send_and_rcvint( src_pn, src_tag, in,
     *                             dest_pn, dest_tag, out )

        implicit none

        integer mp_send_and_rcvint

        integer src_pn,
     &           src_tag,
     &           in,
     &           dest_pn,
     &           dest_tag,
     &           out

      include 'slgcm.mp'

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

      integer dlower(6), dupper(6), lindex, comm_s
      real dwin(4,30)
      common /dvars/ dlower, dupper, lindex, comm_s, dwin

      integer tmp

        tmp = 0

C     For Comm South

        if (comm_s .eq. 1) then
           lindex = lindex - 1
        else
           lindex = lindex + 1
        endif

        if (lindex .eq. 0) then
           lindex = ny
        else if (lindex .eq. 7) then
           lindex = 1
        endif 

        if (comm_s .eq. 1) then 
          in = dlower(lindex)
        else 
          in = dupper(lindex)
        endif

        mp_send_and_rcvint = tmp
        end


       subroutine circ_winbuf(src_pn, src_tag, inbuf, in_i,
     &                        in_j, dest_pn, dest_tag, outbuf, 
     &                        out_i, out_j)

        implicit none

        integer src_pn, src_tag,
     &           in_i, in_j,
     &           dest_pn, dest_tag,
     &           out_i, out_j

        real inbuf(in_i, in_j)
        real outbuf(out_i, out_j)

        integer dlower(6), dupper(6), lindex, comm_s
        real dwin(4,30)
        common /dvars/ dlower, dupper, lindex, comm_s, dwin


        include 'slgcm.mp'
      
        integer i, j, st

        st = (lindex - 1) * max_col_p3

        do i = 1, in_i
          do j = 1, in_j
           inbuf(i,j) = dwin(i, st + j)
          end do
        end do
      end


      subroutine mp_sync()

        implicit none
        
        include 'slgcm.mp'

        integer i

        i = i + 1
        
      end


