/[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.17 by gforget, Thu Oct 9 00:49:26 2014 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_OPTIONS.h"
5  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
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 "CTRL_OBCS.h"
44  #include "optim.h"  #include "optim.h"
45    #endif /* ALLOW_OBCSW_CONTROL */
46    
47  c     == routine arguments ==  c     == routine arguments ==
   
48        _RL     mytime        _RL     mytime
49        integer myiter        integer myiter
50        integer mythid        integer mythid
51    
52    #ifdef ALLOW_OBCSW_CONTROL
53  c     == local variables ==  c     == local variables ==
54    
55        integer bi,bj        integer bi,bj
# Line 76  cgg      _RL maskyz   (1-oly:sny+oly,nr, Line 77  cgg      _RL maskyz   (1-oly:sny+oly,nr,
77    
78        character*(80) fnameobcsw        character*(80) fnameobcsw
79    
80  cgg(  Variables for splitting barotropic/baroclinic vels.  #ifdef ALLOW_OBCS_CONTROL_MODES
81        _RL ubaro        integer nk,nz
82        _RL utop        _RL     tmpz (nr,nsx,nsy)
83  cgg)        _RL     stmp
84    #endif
85    
86  c     == external functions ==  c     == external functions ==
87    
# Line 99  c     == end of interface == Line 101  c     == end of interface ==
101        imax = snx+olx        imax = snx+olx
102        ip1  = 1        ip1  = 1
103    
 cgg(  Initialize variables for balancing volume flux.  
       ubaro = 0.d0  
       utop = 0.d0  
 cgg)  
   
104  c--   Now, read the control vector.  c--   Now, read the control vector.
105        doglobalread = .false.        doglobalread = .false.
106        ladinit      = .false.        ladinit      = .false.
# Line 130  c--   Get the counters, flags, and the i Line 127  c--   Get the counters, flags, and the i
127    
128          do bj = jtlo,jthi          do bj = jtlo,jthi
129           do bi = itlo,ithi           do bi = itlo,ithi
130    #ifdef ALLOW_OBCS_CONTROL_MODES
131              if (iobcs .gt. 2) then
132               do j = jmin,jmax
133                i = OB_Iw(j,bi,bj)
134                IF ( i.EQ.OB_indexNone ) i = 1
135    cih    Determine number of open vertical layers.
136                nz = 0
137                do k = 1,Nr
138                  if (iobcs .eq. 3) then
139                    nz = nz + maskW(i+ip1,j,k,bi,bj)
140                  else
141                    nz = nz + maskS(i,j,k,bi,bj)
142                  endif
143                end do
144    cih    Compute absolute velocities from the barotropic-baroclinic modes.
145                do k = 1,Nr
146                 if (k.le.nz) then
147                  stmp = 0.
148                  do nk = 1,nz
149                   stmp = stmp +
150         &         modesv(k,nk,nz)*tmpfldyz(j,nk,bi,bj)
151                  end do
152                   tmpz(k,bi,bj) = stmp
153                 else
154                  tmpz(k,bi,bj) = 0.
155                 end if
156                enddo
157                do k = 1,Nr
158                  if (iobcs .eq. 3) then
159                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
160         &            *recip_hFacW(i+ip1,j,k,bi,bj)
161                  else
162                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
163         &            *recip_hFacS(i,j,k,bi,bj)
164                  endif
165                end do
166               enddo
167              endif
168    #endif
169            do k = 1,nr            do k = 1,nr
170             do j = jmin,jmax             do j = jmin,jmax
171              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 196  cgg   &
196    
197          do bj = jtlo,jthi          do bj = jtlo,jthi
198           do bi = itlo,ithi           do bi = itlo,ithi
199    #ifdef ALLOW_OBCS_CONTROL_MODES
200              if (iobcs .gt. 2) then
201               do j = jmin,jmax
202                i = OB_Iw(j,bi,bj)
203                IF ( i.EQ.OB_indexNone ) i = 1
204    cih    Determine number of open vertical layers.
205                nz = 0
206                do k = 1,Nr
207                  if (iobcs .eq. 3) then
208                    nz = nz + maskW(i+ip1,j,k,bi,bj)
209                  else
210                    nz = nz + maskS(i,j,k,bi,bj)
211                  endif
212                end do
213    cih    Compute absolute velocities from the barotropic-baroclinic modes.
214                do k = 1,Nr
215                 if (k.le.nz) then
216                  stmp = 0.
217                  do nk = 1,nz
218                   stmp = stmp +
219         &         modesv(k,nk,nz)*tmpfldyz(j,nk,bi,bj)
220                  end do
221                   tmpz(k,bi,bj) = stmp
222                 else
223                   tmpz(k,bi,bj) = 0.
224                 end if
225                enddo
226                do k = 1,Nr
227                  if (iobcs .eq. 3) then
228                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
229         &            *recip_hFacW(i+ip1,j,k,bi,bj)
230                  else
231                    tmpfldyz(j,k,bi,bj) = tmpz(k,bi,bj)
232         &            *recip_hFacS(i,j,k,bi,bj)
233                  endif
234                end do
235               enddo
236              endif
237    #endif
238            do k = 1,nr            do k = 1,nr
239             do j = jmin,jmax             do j = jmin,jmax
240              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 177  c--   Calculate mask for tracer cells (0 Line 252  c--   Calculate mask for tracer cells (0
252           do k = 1,nr           do k = 1,nr
253            do j = 1,sny            do j = 1,sny
254             i = OB_Iw(j,bi,bj)             i = OB_Iw(j,bi,bj)
255               IF ( i.EQ.OB_indexNone ) i = 1
256             if (iobcs .EQ. 1) then             if (iobcs .EQ. 1) then
257              OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)              OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)
258       &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)       &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
# Line 206  c--   Calculate mask for tracer cells (0 Line 282  c--   Calculate mask for tracer cells (0
282           enddo           enddo
283          enddo          enddo
284         enddo         enddo
285          
286  C--   End over iobcs loop  C--   End over iobcs loop
287        enddo        enddo
288    
 #else /* ALLOW_OBCSW_CONTROL undefined */  
   
 c     == routine arguments ==  
   
       _RL     mytime  
       integer myiter  
       integer mythid  
   
 c--   CPP flag ALLOW_OBCSW_CONTROL undefined.  
   
289  #endif /* ALLOW_OBCSW_CONTROL */  #endif /* ALLOW_OBCSW_CONTROL */
290    
291          return
292        end        end
   
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22