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

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

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

revision 1.6 by heimbach, Mon May 14 22:02:33 2007 UTC revision 1.7 by jmc, Tue Oct 9 00:00:00 2007 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
5  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 111  c--   Now, read the control vector. Line 113  c--   Now, read the control vector.
113    
114        if (optimcycle .ge. 0) then        if (optimcycle .ge. 0) then
115          ilobcsn=ilnblnk( xx_obcsn_file )          ilobcsn=ilnblnk( xx_obcsn_file )
116          write(fnameobcsn(1:80),'(2a,i10.10)')          write(fnameobcsn(1:80),'(2a,i10.10)')
117       &       xx_obcsn_file(1:ilobcsn), '.', optimcycle       &       xx_obcsn_file(1:ilobcsn), '.', optimcycle
118        endif        endif
119    
# Line 124  c--   Get the counters, flags, and the i Line 126  c--   Get the counters, flags, and the i
126    
127        do iobcs = 1,nobcs        do iobcs = 1,nobcs
128          if ( obcsnfirst ) then          if ( obcsnfirst ) then
129            call active_read_xz( fnameobcsn, tmpfldxz,            call active_read_xz( fnameobcsn, tmpfldxz,
130       &                         (obcsncount0-1)*nobcs+iobcs,       &                         (obcsncount0-1)*nobcs+iobcs,
131       &                         doglobalread, ladinit, optimcycle,       &                         doglobalread, ladinit, optimcycle,
132       &                         mythid, xx_obcsn_dummy )       &                         mythid, xx_obcsn_dummy )
133    
134  #ifdef ALLOW_CTRL_OBCS_BALANCE  #ifdef ALLOW_CTRL_OBCS_BALANCE
135    
136            if ( optimcycle .gt. 0) then                      if ( optimcycle .gt. 0) then
137              if (iobcs .eq. 3) then              if (iobcs .eq. 3) then
138  cgg         Special attention is needed for the normal velocity.  cgg         Special attention is needed for the normal velocity.
139  cgg         For the north, this is the v velocity, iobcs = 4.  cgg         For the north, this is the v velocity, iobcs = 4.
# Line 143  cgg         This is done on a columnwise Line 145  cgg         This is done on a columnwise
145  cgg         The barotropic velocity is stored in the level 1.  cgg         The barotropic velocity is stored in the level 1.
146                      vbaro = tmpfldxz(i,1,bi,bj)                      vbaro = tmpfldxz(i,1,bi,bj)
147  cgg         Except for the special point which balances barotropic vol.flux.  cgg         Except for the special point which balances barotropic vol.flux.
148  cgg         Special column in the NW corner.  cgg         Special column in the NW corner.
149                      j = OB_Jn(I,bi,bj)                      j = OB_Jn(I,bi,bj)
150                      if (ob_iw(j,bi,bj).eq.(i-1).and.                      if (ob_iw(j,bi,bj).eq.(i-1).and.
151       &                  ob_iw(j,bi,bj).ne. 0) then       &                  ob_iw(j,bi,bj).ne. 0) then
# Line 156  cgg         Special column in the NW cor Line 158  cgg         Special column in the NW cor
158    
159                      do k = 1,Nr                      do k = 1,Nr
160  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
161  cgg      cgg
162  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldxz) does not contain the velocity at the
163  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
164  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
165  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
166                        vtop = tmpfldxz(i,k,bi,bj)*                        vtop = tmpfldxz(i,k,bi,bj)*
167       &                maskS(i,j+jp1,k,bi,bj) * delR(k) + vtop       &                maskS(i,j+jp1,k,bi,bj) * delR(k) + vtop
168  cgg    Add the barotropic velocity component.  cgg    Add the barotropic velocity component.
169                        if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then                        if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then
170                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro
171                        endif                        endif
172                      enddo                      enddo
173  cgg    Compute the baroclinic velocity at level 1. Should balance flux.  cgg    Compute the baroclinic velocity at level 1. Should balance flux.
174                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)
175       &                                      - vtop / delR(1)       &                                      - vtop / delR(1)
176                    enddo                    enddo
177                  enddo                  enddo
# Line 187  cgg         This is done on a columnwise Line 189  cgg         This is done on a columnwise
189  cgg         The barotropic velocity is stored in the level 1.  cgg         The barotropic velocity is stored in the level 1.
190                      vbaro = tmpfldxz(i,1,bi,bj)                      vbaro = tmpfldxz(i,1,bi,bj)
191  cgg         Except for the special point which balances barotropic vol.flux.  cgg         Except for the special point which balances barotropic vol.flux.
192  cgg         Special column in the NW corner.  cgg         Special column in the NW corner.
193                      j = OB_Jn(I,bi,bj)                      j = OB_Jn(I,bi,bj)
194                      tmpfldxz(i,1,bi,bj) = 0.d0                      tmpfldxz(i,1,bi,bj) = 0.d0
195                      vtop = 0.d0                      vtop = 0.d0
196    
197                      do k = 1,Nr                      do k = 1,Nr
198  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
199  cgg      cgg
200  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldxz) does not contain the velocity at the
201  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
202  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
203  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
204                        vtop = tmpfldxz(i,k,bi,bj)*                        vtop = tmpfldxz(i,k,bi,bj)*
205       &                maskW(i,j,k,bi,bj) * delR(k) + vtop       &                maskW(i,j,k,bi,bj) * delR(k) + vtop
206  cgg    Add the barotropic velocity component.  cgg    Add the barotropic velocity component.
207                        if (maskW(i,j,k,bi,bj) .ne. 0.) then                        if (maskW(i,j,k,bi,bj) .ne. 0.) then
208                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro
209                        endif                        endif
210                      enddo                      enddo
211  cgg    Compute the baroclinic velocity at level 1. Should balance flux.  cgg    Compute the baroclinic velocity at level 1. Should balance flux.
212                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)
213       &                                      - vtop / delR(1)       &                                      - vtop / delR(1)
214                    enddo                    enddo
215                  enddo                  enddo
# Line 221  cgg    Compute the baroclinic velocity a Line 223  cgg    Compute the baroclinic velocity a
223            do bj = jtlo,jthi            do bj = jtlo,jthi
224              do bi = itlo,ithi              do bi = itlo,ithi
225                do k = 1,nr                do k = 1,nr
226                  do i = imin,imax                  do i = imin,imax
227                    xx_obcsn1(i,k,bi,bj,iobcs)  = tmpfldxz (i,k,bi,bj)                    xx_obcsn1(i,k,bi,bj,iobcs)  = tmpfldxz (i,k,bi,bj)
228  cgg     &                                        *   maskxz (i,k,bi,bj)  cgg     &                                        *   maskxz (i,k,bi,bj)
229                  enddo                  enddo
# Line 231  cgg     & Line 233  cgg     &
233          endif          endif
234    
235          if ( (obcsnfirst) .or. (obcsnchanged)) then          if ( (obcsnfirst) .or. (obcsnchanged)) then
236              
237            do bj = jtlo,jthi            do bj = jtlo,jthi
238              do bi = itlo,ithi              do bi = itlo,ithi
239                do k = 1,nr                do k = 1,nr
# Line 254  cgg     & Line 256  cgg     &
256              enddo              enddo
257            enddo            enddo
258    
259            call active_read_xz( fnameobcsn, tmpfldxz,            call active_read_xz( fnameobcsn, tmpfldxz,
260       &                         (obcsncount1-1)*nobcs+iobcs,       &                         (obcsncount1-1)*nobcs+iobcs,
261       &                         doglobalread, ladinit, optimcycle,       &                         doglobalread, ladinit, optimcycle,
262       &                         mythid, xx_obcsn_dummy )       &                         mythid, xx_obcsn_dummy )
263    
264  #ifdef ALLOW_CTRL_OBCS_BALANCE  #ifdef ALLOW_CTRL_OBCS_BALANCE
265    
266            if ( optimcycle .gt. 0) then                      if ( optimcycle .gt. 0) then
267              if (iobcs .eq. 3) then              if (iobcs .eq. 3) then
268  cgg         Special attention is needed for the normal velocity.  cgg         Special attention is needed for the normal velocity.
269  cgg         For the north, this is the v velocity, iobcs = 3.  cgg         For the north, this is the v velocity, iobcs = 3.
# Line 273  cgg         This is done on a columnwise Line 275  cgg         This is done on a columnwise
275  cgg         The barotropic velocity is stored in the level 1.  cgg         The barotropic velocity is stored in the level 1.
276                      vbaro = tmpfldxz(i,1,bi,bj)                      vbaro = tmpfldxz(i,1,bi,bj)
277  cgg         Except for the special point which balances barotropic vol.flux.  cgg         Except for the special point which balances barotropic vol.flux.
278  cgg         Special column in the NW corner.  cgg         Special column in the NW corner.
279                      j = OB_Jn(I,bi,bj)                      j = OB_Jn(I,bi,bj)
280                      if (ob_iw(j,bi,bj).eq.(i-1).and.                      if (ob_iw(j,bi,bj).eq.(i-1).and.
281       &                    ob_iw(j,bi,bj).ne. 0) then       &                    ob_iw(j,bi,bj).ne. 0) then
# Line 287  cgg         Special column in the NW cor Line 289  cgg         Special column in the NW cor
289    
290                      do k = 1,Nr                      do k = 1,Nr
291  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
292  cgg      cgg
293  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldxz) does not contain the velocity at the
294  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
295  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
296  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
297                        vtop = tmpfldxz(i,k,bi,bj)*                        vtop = tmpfldxz(i,k,bi,bj)*
298       &                maskS(i,j+jp1,k,bi,bj) * delR(k) + vtop       &                maskS(i,j+jp1,k,bi,bj) * delR(k) + vtop
299  cgg    Add the barotropic velocity component.  cgg    Add the barotropic velocity component.
300                        if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then                        if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then
301                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro
302                        endif                        endif
303                      enddo                      enddo
304  cgg    Compute the baroclinic velocity at level 1. Should balance flux.  cgg    Compute the baroclinic velocity at level 1. Should balance flux.
305                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)
306       &                                      - vtop / delR(1)       &                                      - vtop / delR(1)
307                    enddo                    enddo
308                  enddo                  enddo
# Line 317  cgg         This is done on a columnwise Line 319  cgg         This is done on a columnwise
319  cgg         The barotropic velocity is stored in the level 1.  cgg         The barotropic velocity is stored in the level 1.
320                      vbaro = tmpfldxz(i,1,bi,bj)                      vbaro = tmpfldxz(i,1,bi,bj)
321  cgg         Except for the special point which balances barotropic vol.flux.  cgg         Except for the special point which balances barotropic vol.flux.
322  cgg         Special column in the NW corner.  cgg         Special column in the NW corner.
323                      j = OB_Jn(I,bi,bj)                      j = OB_Jn(I,bi,bj)
324                      tmpfldxz(i,1,bi,bj) = 0.d0                      tmpfldxz(i,1,bi,bj) = 0.d0
325                      vtop = 0.d0                      vtop = 0.d0
326    
327                      do k = 1,Nr                      do k = 1,Nr
328  cgg    If cells are not full, this should be modified with hFac.  cgg    If cells are not full, this should be modified with hFac.
329  cgg      cgg
330  cgg    The xx field (tmpfldxz) does not contain the velocity at the  cgg    The xx field (tmpfldxz) does not contain the velocity at the
331  cgg    surface level. This velocity is not independent; it must  cgg    surface level. This velocity is not independent; it must
332  cgg    exactly balance the volume flux, since we are dealing with  cgg    exactly balance the volume flux, since we are dealing with
333  cgg    the baroclinic velocity structure..  cgg    the baroclinic velocity structure..
334                        vtop = tmpfldxz(i,k,bi,bj)*                        vtop = tmpfldxz(i,k,bi,bj)*
335       &                maskW(i,j,k,bi,bj) * delR(k) + vtop       &                maskW(i,j,k,bi,bj) * delR(k) + vtop
336  cgg    Add the barotropic velocity component.  cgg    Add the barotropic velocity component.
337                        if (maskW(i,j,k,bi,bj) .ne. 0.) then                        if (maskW(i,j,k,bi,bj) .ne. 0.) then
338                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro                          tmpfldxz(i,k,bi,bj) = tmpfldxz(i,k,bi,bj)+ vbaro
339                        endif                        endif
340                      enddo                      enddo
341  cgg    Compute the baroclinic velocity at level 1. Should balance flux.  cgg    Compute the baroclinic velocity at level 1. Should balance flux.
342                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)                      tmpfldxz(i,1,bi,bj) = tmpfldxz(i,1,bi,bj)
343       &                                      - vtop / delR(1)       &                                      - vtop / delR(1)
344                    enddo                    enddo
345                  enddo                  enddo
# Line 403  cgg     &                      *maskxz(i Line 405  cgg     &                      *maskxz(i
405    
406  C--   End over iobcs loop  C--   End over iobcs loop
407        enddo        enddo
408          
409  #else /* ALLOW_OBCSN_CONTROL undefined */  #else /* ALLOW_OBCSN_CONTROL undefined */
410    
411  c     == routine arguments ==  c     == routine arguments ==
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22