#include "CTRL_CPPOPTIONS.h"
#ifdef ALLOW_OBCS
# include "OBCS_OPTIONS.h"
#endif


      subroutine ctrl_getobcsw(
     I                             mytime,
     I                             myiter,
     I                             mythid
     &                           )

c     ==================================================================
c     SUBROUTINE ctrl_getobcsw
c     ==================================================================
c
c     o Get norhtern obc of the control vector and add it
c       to dyn. fields
c
c     started: heimbach@mit.edu, 29-Aug-2001
c
c     ==================================================================
c     SUBROUTINE ctrl_getobcsw
c     ==================================================================

      implicit none

#ifdef ALLOW_OBCSW_CONTROL

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"
#include "OBCS.h"

#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"

c     == routine arguments ==

      _RL     mytime
      integer myiter
      integer mythid

c     == local variables ==

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer ilobcsw
      integer iobcs

      _RL     dummy
      _RL     obcswfac
      logical obcswfirst
      logical obcswchanged
      integer obcswcount0
      integer obcswcount1

      _RL maskyz   (1-oly:sny+oly,nr,nsx,nsy)

      logical doglobalread
      logical ladinit

      character*(80) fnameobcsw

      

c     == external functions ==

      integer  ilnblnk
      external ilnblnk


c     == end of interface ==

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)
      jmin = 1-oly
      jmax = sny+oly
      imin = 1-olx
      imax = snx+olx

c--   Now, read the control vector.
      doglobalread = .false.
      ladinit      = .false.

      if (optimcycle .ge. 0) then
        ilobcsw=ilnblnk( xx_obcsw_file )
        write(fnameobcsw(1:80),'(2a,i10.10)') 
     &       xx_obcsw_file(1:ilobcsw), '.', optimcycle
      else
        print*
        print*,' ctrl_getobcsw: optimcycle not set correctly.'
        print*,' ... stopped in ctrl_getobcsw.'
      endif

c--   Get the counters, flags, and the interpolation factor.
      call ctrl_GetRec( 'xx_obcsw',
     O                   obcswfac, obcswfirst, obcswchanged,
     O                   obcswcount0,obcswcount1,
     I                   mytime, myiter, mythid )

      do iobcs = 1,nobcs

        call active_read_yz( 'maskobcsw', maskyz, 
     &                       iobcs,
     &                       doglobalread, ladinit, 0,
     &                       mythid, dummy )

        call active_read_yz( fnameobcsw, tmpfldyz, 
     &                       (obcswcount0-1)*nobcs+iobcs,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_obcsw_dummy )

        do bj = jtlo,jthi
          do bi = itlo,ithi
            do k = 1,nr
              do j = jmin,jmax
                yz_obcs0(j,k,bi,bj)  = tmpfldyz (j,k,bi,bj)
              enddo
            enddo
          enddo
        enddo

        call active_read_yz( fnameobcsw, tmpfldyz, 
     &                       (obcswcount1-1)*nobcs+iobcs,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_obcsw_dummy )

        do bj = jtlo,jthi
          do bi = itlo,ithi
            do k = 1,nr
              do j = jmin,jmax
                yz_obcs1 (j,k,bi,bj) = tmpfldyz (j,k,bi,bj)
              enddo
            enddo
          enddo
        enddo

c--     Add control to model variable.
        do bj = jtlo,jthi
           do bi = itlo,ithi
c--        Calculate mask for tracer cells (0 => land, 1 => water).
              do k = 1,nr
                 do j = 1,sny
                    if (iobcs .EQ. 1) then
                       OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)
     &                      + obcswfac            *yz_obcs0(j,k,bi,bj)
     &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)
                       OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj)
     &                      *maskyz(j,k,bi,bj)
                    else if (iobcs .EQ. 2) then
                       OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj)
     &                      + obcswfac            *yz_obcs0(j,k,bi,bj)
     &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)
                       OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj)
     &                      *maskyz(j,k,bi,bj)
                    else if (iobcs .EQ. 3) then
                       OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj)
     &                      + obcswfac            *yz_obcs0(j,k,bi,bj)
     &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)
                       OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)
     &                      *maskyz(j,k,bi,bj)
                    else if (iobcs .EQ. 4) then
                       OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj)
     &                      + obcswfac            *yz_obcs0(j,k,bi,bj)
     &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)
                       OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)
     &                      *maskyz(j,k,bi,bj)
                    endif
                 enddo
              enddo
           enddo
        enddo

C--   End over iobcs loop
      enddo

#else /* ALLOW_OBCSW_CONTROL undefined */

c     == routine arguments ==

      _RL     mytime
      integer myiter
      integer mythid

c--   CPP flag ALLOW_OBCSW_CONTROL undefined.

#endif /* ALLOW_OBCSW_CONTROL */

      end