/[MITgcm]/MITgcm/pkg/ctrl/ctrl_getobcsw.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_getobcsw.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.9 by mlosch, Wed Jan 19 08:42:06 2011 UTC revision 1.10 by mlosch, Mon Mar 7 09:24:10 2011 UTC
# Line 69  c     == local variables == Line 69  c     == local variables ==
69        integer obcswcount1        integer obcswcount1
70    
71  cgg      _RL maskyz   (1-oly:sny+oly,nr,nsx,nsy)  cgg      _RL maskyz   (1-oly:sny+oly,nr,nsx,nsy)
72          _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
73    
74        logical doglobalread        logical doglobalread
75        logical ladinit        logical ladinit
# Line 120  c--   Get the counters, flags, and the i Line 121  c--   Get the counters, flags, and the i
121       O                   obcswcount0,obcswcount1,       O                   obcswcount0,obcswcount1,
122       I                   mytime, myiter, mythid )       I                   mytime, myiter, mythid )
123    
124    CML      print *,'ml-getobcs: ',myIter,obcswfirst,obcswchanged,
125    CML     &     obcswcount0,obcswcount1,obcswfac
126        do iobcs = 1,nobcs        do iobcs = 1,nobcs
127          if ( obcswfirst ) then          if ( obcswfirst ) then
128            call active_read_yz( fnameobcsw, tmpfldyz,            call active_read_yz( fnameobcsw, tmpfldyz,
# Line 147  cgg         The barotropic velocity is s Line 150  cgg         The barotropic velocity is s
150                      do k = 1,Nr                      do k = 1,Nr
151  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
152  cgg  cgg
153  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldyz) does not contain the velocity at the
154  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
155  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
156  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
# Line 182  cgg         The barotropic velocity is s Line 185  cgg         The barotropic velocity is s
185                      do k = 1,Nr                      do k = 1,Nr
186  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
187  cgg  cgg
188  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldyz) does not contain the velocity at the
189  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
190  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
191  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
# Line 254  cgg         The barotropic velocity is s Line 257  cgg         The barotropic velocity is s
257                      do k = 1,Nr                      do k = 1,Nr
258  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
259  cgg  cgg
260  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldyz) does not contain the velocity at the
261  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
262  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
263  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
# Line 289  cgg         The barotropic velocity is s Line 292  cgg         The barotropic velocity is s
292                      do k = 1,Nr                      do k = 1,Nr
293  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
294  cgg  cgg
295  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldyz) does not contain the velocity at the
296  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
297  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
298  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
# Line 323  cgg     & Line 326  cgg     &
326            enddo            enddo
327          endif          endif
328    
329  c--     Add control to model variable.  c--   Add control to model variable.
330          do bj = jtlo, jthi          do bj = jtlo, jthi
331             do bi = itlo, ithi           do bi = itlo, ithi
332  c--        Calculate mask for tracer cells (0 => land, 1 => water).  c--   Calculate mask for tracer cells (0 => land, 1 => water).
333                do k = 1,nr            do k = 1,nr
334                   do j = 1,sny             do j = 1,sny
335                      i = OB_Iw(j,bi,bj)              i = OB_Iw(j,bi,bj)
336                      if (iobcs .EQ. 1) then              if (iobcs .EQ. 1) then
337                         OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)               OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)
338       &                 + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)       &            + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
339       &                 + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)       &            + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
340                         OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj)               OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj)
341       &                      *maskW(i+ip1,j,k,bi,bj)       &            *maskW(i+ip1,j,k,bi,bj)
342                      else if (iobcs .EQ. 2) then              else if (iobcs .EQ. 2) then
343                         OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj)               OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj)
344       &                 + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)       &            + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
345       &                 + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)       &            + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
346                         OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj)               OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj)
347       &                      *maskW(i+ip1,j,k,bi,bj)       &            *maskW(i+ip1,j,k,bi,bj)
348                      else if (iobcs .EQ. 3) then              else if (iobcs .EQ. 3) then
349                         OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj)               OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj)
350       &                 + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)       &            + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
351       &                 + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)       &            + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
352                         OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)               OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)
353       &                      *maskW(i+ip1,j,k,bi,bj)       &            *maskW(i+ip1,j,k,bi,bj)
354                      else if (iobcs .EQ. 4) then              else if (iobcs .EQ. 4) then
355                         OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj)               OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj)
356       &                 + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)       &            + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
357       &                 + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)       &            + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
358                         OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)               OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)
359       &                      *maskS(i,j,k,bi,bj)       &            *maskS(i,j,k,bi,bj)
360                      endif              endif
                  enddo  
               enddo  
361             enddo             enddo
362              enddo
363             enddo
364          enddo          enddo
365    
366  C--   End over iobcs loop  C--   End over iobcs loop
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22