/[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.11 by mlosch, Mon Mar 14 17:08:00 2011 UTC revision 1.14 by heimbach, Tue Jul 31 16:05:56 2012 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  # include "OBCS_OPTIONS.h"  # include "OBCS_OPTIONS.h"
7  #endif  #endif
8    
   
9        subroutine ctrl_getobcsw(        subroutine ctrl_getobcsw(
10       I                             mytime,       I                             mytime,
11       I                             myiter,       I                             myiter,
# Line 29  c     ================================== Line 28  c     ==================================
28    
29        implicit none        implicit none
30    
 #ifdef ALLOW_OBCSW_CONTROL  
   
31  c     == global variables ==  c     == global variables ==
32    #ifdef ALLOW_OBCSW_CONTROL
33  #include "EEPARAMS.h"  #include "EEPARAMS.h"
34  #include "SIZE.h"  #include "SIZE.h"
35  #include "PARAMS.h"  #include "PARAMS.h"
36  #include "GRID.h"  #include "GRID.h"
37  #include "OBCS.h"  c#include "OBCS_PARAMS.h"
38    #include "OBCS_GRID.h"
39    #include "OBCS_FIELDS.h"
40    #include "CTRL_SIZE.h"
41  #include "ctrl.h"  #include "ctrl.h"
42  #include "ctrl_dummy.h"  #include "ctrl_dummy.h"
43  #include "optim.h"  #include "optim.h"
44    #endif /* ALLOW_OBCSW_CONTROL */
45    
46  c     == routine arguments ==  c     == routine arguments ==
   
47        _RL     mytime        _RL     mytime
48        integer myiter        integer myiter
49        integer mythid        integer mythid
50    
51    #ifdef ALLOW_OBCSW_CONTROL
52  c     == local variables ==  c     == local variables ==
53    
54        integer bi,bj        integer bi,bj
# Line 76  cgg      _RL maskyz   (1-oly:sny+oly,nr, Line 76  cgg      _RL maskyz   (1-oly:sny+oly,nr,
76    
77        character*(80) fnameobcsw        character*(80) fnameobcsw
78    
79  cgg(  Variables for splitting barotropic/baroclinic vels.  #ifdef ALLOW_OBCS_CONTROL_MODES
80        _RL ubaro        integer nk,nz
81        _RL utop        _RL     tmpz (nr,nsx,nsy)
82  cgg)        _RL     stmp
83    #endif
84    
85  c     == external functions ==  c     == external functions ==
86    
# Line 99  c     == end of interface == Line 100  c     == end of interface ==
100        imax = snx+olx        imax = snx+olx
101        ip1  = 1        ip1  = 1
102    
 cgg(  Initialize variables for balancing volume flux.  
       ubaro = 0.d0  
       utop = 0.d0  
 cgg)  
   
103  c--   Now, read the control vector.  c--   Now, read the control vector.
104        doglobalread = .false.        doglobalread = .false.
105        ladinit      = .false.        ladinit      = .false.
# Line 130  c--   Get the counters, flags, and the i Line 126  c--   Get the counters, flags, and the i
126    
127          do bj = jtlo,jthi          do bj = jtlo,jthi
128           do bi = itlo,ithi           do bi = itlo,ithi
129    #ifdef ALLOW_OBCS_CONTROL_MODES
130              if (iobcs .gt. 2) then
131               do j = jmin,jmax
132                i = OB_Iw(j,bi,bj)
133    cih    Determine number of open vertical layers.
134                nz = 0
135                do k = 1,Nr
136                  if (iobcs .eq. 3) then
137                    nz = nz + maskW(i+ip1,j,k,bi,bj)
138                  else
139                    nz = nz + maskS(i,j,k,bi,bj)
140                  endif
141                end do
142    cih    Compute absolute velocities from the barotropic-baroclinic modes.
143                do k = 1,Nr
144                 if (k.le.nz) then
145                  stmp = 0.
146                  do nk = 1,nz
147                   stmp = stmp +
148         &         modesv(k,nk,nz)*tmpfldyz(j,nk,bi,bj)
149                  end do
150                   tmpz(k,bi,bj) = stmp
151                 else
152                  tmpz(k,bi,bj) = 0.
153                 end if
154                enddo
155                do k = 1,Nr
156                  if (iobcs .eq. 3) then
157                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
158         &            *recip_hFacW(i+ip1,j,k,bi,bj)
159                  else
160                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
161         &            *recip_hFacS(i,j,k,bi,bj)
162                  endif
163                end do
164               enddo
165              endif
166    #endif
167            do k = 1,nr            do k = 1,nr
168             do j = jmin,jmax             do j = jmin,jmax
169              xx_obcsw1(j,k,bi,bj,iobcs)  = tmpfldyz (j,k,bi,bj)              xx_obcsw1(j,k,bi,bj,iobcs)  = tmpfldyz (j,k,bi,bj)
# Line 160  cgg   & Line 194  cgg   &
194    
195          do bj = jtlo,jthi          do bj = jtlo,jthi
196           do bi = itlo,ithi           do bi = itlo,ithi
197    #ifdef ALLOW_OBCS_CONTROL_MODES
198              if (iobcs .gt. 2) then
199               do j = jmin,jmax
200                i = OB_Iw(j,bi,bj)
201    cih    Determine number of open vertical layers.
202                nz = 0
203                do k = 1,Nr
204                  if (iobcs .eq. 3) then
205                    nz = nz + maskW(i+ip1,j,k,bi,bj)
206                  else
207                    nz = nz + maskS(i,j,k,bi,bj)
208                  endif
209                end do
210    cih    Compute absolute velocities from the barotropic-baroclinic modes.
211                do k = 1,Nr
212                 if (k.le.nz) then
213                  stmp = 0.
214                  do nk = 1,nz
215                   stmp = stmp +
216         &         modesv(k,nk,nz)*tmpfldyz(j,nk,bi,bj)
217                  end do
218                   tmpz(k,bi,bj) = stmp
219                 else
220                   tmpz(k,bi,bj) = 0.
221                 end if
222                enddo
223                do k = 1,Nr
224                  if (iobcs .eq. 3) then
225                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
226         &            *recip_hFacW(i+ip1,j,k,bi,bj)
227                  else
228                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
229         &            *recip_hFacS(i,j,k,bi,bj)
230                  endif
231                end do
232               enddo
233              endif
234    #endif
235            do k = 1,nr            do k = 1,nr
236             do j = jmin,jmax             do j = jmin,jmax
237              xx_obcsw1 (j,k,bi,bj,iobcs) = tmpfldyz (j,k,bi,bj)              xx_obcsw1 (j,k,bi,bj,iobcs) = tmpfldyz (j,k,bi,bj)
# Line 206  c--   Calculate mask for tracer cells (0 Line 278  c--   Calculate mask for tracer cells (0
278           enddo           enddo
279          enddo          enddo
280         enddo         enddo
281          
282  C--   End over iobcs loop  C--   End over iobcs loop
283        enddo        enddo
284    
 #else /* ALLOW_OBCSW_CONTROL undefined */  
   
 c     == routine arguments ==  
   
       _RL     mytime  
       integer myiter  
       integer mythid  
   
 c--   CPP flag ALLOW_OBCSW_CONTROL undefined.  
   
285  #endif /* ALLOW_OBCSW_CONTROL */  #endif /* ALLOW_OBCSW_CONTROL */
286    
287          return
288        end        end
   
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22