--- MITgcm/pkg/ctrl/ctrl_getobcsw.F	2002/02/05 20:23:58	1.1
+++ MITgcm/pkg/ctrl/ctrl_getobcsw.F	2002/02/05 20:23:58	1.1.2.1
@@ -0,0 +1,202 @@
+
+#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
+