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

      subroutine bic_mp(wina_d, woua_d,faclama, facphia,
     *                   winb_d, woub_d,faclamb, facphib, 
     *                   rlatitude_d, rlongitude_d, ja, jb,
     *                   lo, up)

      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

C***  Debug Variables
C1          integer comm_a
C1          common /switch/ comm_a

      integer lo, up
      integer ja, jb
      real    faclama,
     &         faclamb,
     &         facphia,
     &         facphib


       real wina_d(imp3, max_col_p3)
       real woua_d(imp3, max_col_p3)
       real winb_d(imp3, max_col_p3)
       real woub_d(imp3, max_col_p3)
       real rlatitude_d(imp3, max_col_p3)
       real rlongitude_d(imp3, max_col_p3)
       
      dimension tem1_d(imp3, max_col_p3)
      dimension tem2_d(imp3, max_col_p3)
      dimension core1_d(imp3, max_col_p3)
      dimension ii_d(imp3, max_col_p3)
      dimension jj_d(imp3, max_col_p3)

      real tem1_d,
     &      tem2_d,
     &      core1_d
      integer ii_d,
     &         jj_d
      integer  lo1, up1, tmp, range
      integer  i, j,  svdlo, svdup

CD
      integer dny0, drange
CD
C***    Timing Code 
C1      real*8   etime,
C1     &         btime,
C1     &         itime
C***    Timing Code 

      real    facdlma
      real    facdlmb, r

C***    Timing Code 
C1      integer mp_timer_clear
C1      integer mp_timer_start
C1      integer mp_timer_stop
C1      real*8 mp_elapsed_time
C1      real*8 mp_busy_time
C1      real*8 mp_idle_time
C***    Timing Code 


CD
 108  format ( I10, F16.8)
 109  format ( I10, I4)
      
C1              drange = up -lo + 1
C1              if (ny0 .eq. 0) then
C1                 print *, '+WINA'
C1              endif
C1
C1              do j = 1, drange
C1                 do i = 1, imp3
C1                    dny0 = 100000 + ny0 * 1000 + j * 10 + i
C1                    print 108, dny0, wina_d(i,j)
C1                 end do
C1              end do
C1              call mp_sync()
C1
C1              if (ny0 .eq. 0) then
C1                 print *, '+RLAT'
C1              endif
C1              if (ny0 .eq. (ny-1)) then
C1                 drange = jm - lo + 1
C1              endif
C1              do j = 1, drange
C1                 do i = 1, imp3
C1                    dny0 = 100000 + ny0 * 1000 + j * 10 + i
C1                    print 108, dny0, rlatitude_d(i,j)
C1                 end do
C1              end do
C1              call mp_sync()

      lo1 = 1
      up1 = up
      if (ny0 .eq. ny -1) then
         up1 = jb
      endif
      if (ny0 .eq. 0) then
         lo1 = ja
      endif

      range = up1 - lo + 1
      

C1      call mp_init()

C***    Timing Code - Part 1
C1	tmp = mp_timer_clear(0)
C1        if (tmp .eq. -1) then
C1           print *, 'Failure in clearing timer'
C1           stop
C1        end if
C1        tmp = mp_timer_start(0)
C1        if (tmp .eq. -1) then
C1           print *, 'Failure in starting timer'
C1           stop
C1        end if
C***    Timing Code - Part 1


c r transforms radians into "turns" 
	r=one/twopi
c dlm is 2*pi/im
c u and v quantities are offset differently from the equator.
        facdlma = (2.-faclama)*dlm 
        facdlmb = (2.-faclamb)*dlm

CD
CD        print '(I4, "Lo", I4, " Up", I4, " Lo1", I4, " Up1", 
CD     &          I4, " Range"
CD     &          I4, " Ja", I4, " Jb", I4)', ny0, lo, up, lo1, up1,
CD     &          range, ja, jb
CD

C        do j = 1, range 
        do j = lo1, range
           do i = 1,imp3

c add enough turns as to have a positive lon
c and compute the index number of the grid point to the
c east of the lon 
CD
CD          if (ny0 .eq. 1) then
CD             print '(" ITER : J ", I4, " I ", I4)', j, i
CD             print '(" rlon", F16.8, " facdlma", F4.2,
CD     &       " r", F16.8)', rlongitude_d(i,j), facdlma, r
CD          endif
CD
          tem1_d(i,j) = (rlongitude_d(i,j)-facdlma)*r   
          ii_d(i,j) =  int(tem1_d(i,j))
CD
CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)
CD
C1          PRINT *, 'First time ii', ii_d(i,j)
c if started with a negative give a turn more to get into positive 
c angles
	 if(tem1_d(i,j) .lt. 0.) ii_d(i,j) = ii_d(i,j)-1
CD
CD         if (ny0 .eq. 1) PRINT *, 'Second Time ii ', ii_d(i,j)
CD
c get the actual gridpoint index in the lon direction
	   tem1_d(i,j) = (tem1_d(i,j) - ii_d(i,j))*im+two
           ii_d(i,j) = int(tem1_d(i,j))
CD
CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II ", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)
CD
C1          PRINT *, 'Third Time ii', ii_d(i,j)
           tem1_d(i,j) = tem1_d(i,j) - ii_d(i,j)
           if(ii_d(i,j).eq.1)ii_d(i,j) = imp1
C1          PRINT *, 'Third Time ii', ii_d(i,j)
CD
CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)
CD
c same thing for the latitudes 
c the computation for core1 can be used for the second field
         core1_d(i,j) = (  rlatitude_d(i,j) + pio2)*rdph 
         tem2_d(i,j) = core1_d(i,j) + facphia
         jj_d(i,j) = int(tem2_d(i,j))
         tem2_d(i,j) = tem2_d(i,j) - jj_d(i,j)
        enddo
       enddo

        svdlo = lo
        svdup = up
C1        call circulate(wina_d, tem1_d,  tem2_d, 
C1     &                 woua_d, ii_d,    jj_d,
C1     &                 svdlo,     svdup,     
C1     &                 ja,     jb)
  
C*** Debug Code      
CD        comm_a  = 1

CD              drange = up -lo + 1
CD              if (ny0 .eq. 0) then
CD                 print *, '+II'
CD              endif
CD              call mp_sync()
CD
CD              do j = lo1, range
CD                 do i = 1, imp3
CD                    dny0 = 100000 + ny0 * 1000 + j * 10 + i
CD                    print 109, dny0, ii_d(i,j)
CD                 end do
CD              end do
CD              call mp_sync()
CD
CD              if (ny0 .eq. 0) then
CD                 print *, '+JJ'
CD              endif
CD              call mp_sync()
CD
CD              do j = lo1, range
CD                 do i = 1, imp3
CD                    dny0 = 200000 + ny0 * 1000 + j * 10 + i
CD                    print 109, dny0, jj_d(i,j)
CD                 end do
CD              end do
CD              call mp_sync()
CD
CD              if (ny0 .eq. 0) then
CD                 print *, '+TEM1D'
CD              endif
CD
CD              do j = lo1, range
CD                 do i = 1, imp3
CD                    dny0 = 300000 + ny0 * 1000 + j * 10 + i
CD                    print 108, dny0, tem1_d(i,j)
CD                 end do
CD              end do
CD
CD              call mp_sync()
CD              if (ny0 .eq. 0) then
CD                 print *, '+TEM2D'
CD              endif
CD
CD              do j = lo1, range
CD                 do i = 1, imp3
CD                    dny0 = 400000 + ny0 * 1000 + j * 10 + i
CD                    print 108, dny0, tem2_d(i,j)
CD                 end do
CD              end do
CD
CD              call mp_sync()


        call locubit(wina_d, tem1_d, tem2_d,  woua_d,
     &               ii_d,  jj_d, svdlo, svdup, ja, jb)



CD        print '(I4, "Lo", I4, " Up", I4, " Lo1", I4, " Up1", 
CD     &          I4, " Range",
CD     &          I4, " Ja", I4, " Jb", I4)', ny0, lo, up, lo1, up1,
CD     &          range, ja, jb


           
C1        do j = 1, range 
        do j = lo1, range 
	 do i = 1,imp3
c
c
c the comments are the same as above

CD          if (ny0 .eq. 1) then
CD             print '(" ITER : J ", I4, " I ", I4)', j, i
CD             print '(" rlon", F16.8, " facdlma", F4.2,
CD     &       " r", F16.8)', rlongitude_d(i,j), facdlma, r
CD          endif

          tem1_d(i,j) = (rlongitude_d(i,j)-facdlmb)*r  
          ii_d(i,j) =  int(tem1_d(i,j))

CD
CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)
CD
	  if(tem1_d(i,j) .lt. 0.) ii_d(i,j) = ii_d(i,j) -1

CD          if (ny0 .eq. 1) PRINT *, 'Second Time ii ', ii_d(i,j)

	  tem1_d(i,j) = (tem1_d(i,j) - ii_d(i,j))*im+two
          ii_d(i,j) = int(tem1_d(i,j))

CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II ", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)

          tem1_d(i,j) = tem1_d(i,j) - ii_d(i,j)
          if(ii_d(i,j) .eq. 1) ii_d(i,j) = imp1


CD          if (ny0 .eq. 1) print '(" tem1", F16.8, " II", I4)',
CD     &      tem1_d(i,j), ii_d(i,j)

c same thing for the latitudes 
CD
CD          if (ny0 .eq. 1) then
CD              print '(" rlat", F16.8, " facphib", F16.8)',
CD     &        rlatitude_d(i,j), facphib
CD              print '(" rdph", F16.8, " pio2", F16.8)', rdph, pio2
CD            core1 = (rlatitude(i,j) + pio2) * rdph
CD            print '(" core1", F16.8)', core1_d(i,j)
CD         endif
CD
          tem2_d(i,j) = core1_d(i,j) + facphib
          jj_d(i,j) = int(tem2_d(i,j))
CD
CD          if (ny0 .eq. 1) print '(" tem2", F16.8, 
CD     &     " JJ ", I4)', tem2_d(i,j), jj_d(i,j)
CD
          tem2_d(i,j) = tem2_d(i,j) - jj_d(i,j)

CD
CD          if (ny0 .eq. 1) print '(" tem2", F16.8)',
CD     &     tem2_d(i,j)
CD
         enddo
        enddo

        svdlo = lo
        svdup = up
C1        call circulate(winb_d, tem1_d,  tem2_d, 
C1     &                 woub_d, ii_d,    jj_d,
C1     &                 svdlo,     svdup,      
C1     &                 ja,     jb)

C*** Debug Code      
CD        comm_a = 0
        call locubit(winb_d, tem1_d, tem2_d,  woub_d,
     &               ii_d,  jj_d, svdlo, svdup, ja, jb)
           

 107    format ( I10, F16.8, F16.8)
C1
CD             range = up - lo + 1
CD              if (ny0 .eq. 0) then
CD                 print *, '+WOU'
CD              endif
CD              if (ny0 .eq. (ny-1)) then
CD                 range = jm - lo + 1
CD              endif
CD              do j = 1, range
CD                 do i = 1, imp3
CD                    dny0 = 100000 + ny0 * 1000 + j * 10 + i
CD                    print 107, dny0, woua_d(i,j), woub_d(i,j)
CD                 end do
CD              end do
CD              call mp_sync()

C***    Timing Code - Part 2
        
C1        tmp = mp_timer_stop(0)
C1        if (tmp .eq. -1) then
C1           print *, 'Failure in stopping timer'
C1           stop
C1        end if
C1
C1        etime = mp_elapsed_time(0)
C1        btime = mp_busy_time(0)
C1        itime = mp_idle_time(0)
C1
C1      if (ny0 .eq. 15) then
C1        print 200, ">Node : ",ny0, " , Circul elapse time: ", etime
C1      endif
C1 200    format (A, I3, A, E22.15.3)
C1
C1        print 200, ">Node : ",ny0, " , Circul elapse time: ", etime
C1        print 200, ">Node : ",ny0, " , Circul calcn. time: ", btime
C***    Timing Code - Part 2

C       End of routine bic_mp
      return
      end

