/[MITgcm]/MITgcm/pkg/obcs/obcs_calc.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_calc.F

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

revision 1.10 by heimbach, Tue Oct 12 18:37:38 2004 UTC revision 1.24 by jahn, Tue Dec 15 17:03:28 2009 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
5    
6        SUBROUTINE OBCS_CALC( bi, bj, futureTime, futureIter,        SUBROUTINE OBCS_CALC( futureTime, futureIter,
7       &                      uVel, vVel, wVel, theta, salt,       &                      uVel, vVel, wVel, theta, salt,
8       &                      myThid )       &                      myThid )
9  C     |==========================================================|  C     |==========================================================|
10  C     | SUBROUTINE OBCS_CALC                                     |  C     | SUBROUTINE OBCS_CALC                                     |
# Line 19  C     === Global variables === Line 19  C     === Global variables ===
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "EEPARAMS.h"  #include "EEPARAMS.h"
21  #include "PARAMS.h"  #include "PARAMS.h"
22  #include "GRID.h"  #include "GRID.h"
23  #include "OBCS.h"  #include "OBCS.h"
24    #ifdef ALLOW_PTRACERS
25    #include "PTRACERS_SIZE.h"
26    #include "PTRACERS_PARAMS.h"
27    #include "PTRACERS_FIELDS.h"
28    #include "OBCS_PTRACERS.h"
29    #endif /* ALLOW_PTRACERS */
30    
31  C     == Routine arguments ==  C     == Routine arguments ==
       INTEGER bi, bj  
32        INTEGER futureIter        INTEGER futureIter
33        _RL futureTime        _RL futureTime
34        _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
# Line 36  C     == Routine arguments == Line 41  C     == Routine arguments ==
41  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
42    
43  C     == Local variables ==  C     == Local variables ==
44    C     bi, bj        :: tile indices
45    C     I,J,K        - loop indices
46    C     I_obc, J_obc - local index of open boundary
47    C     msgBuf       - Informational/error meesage buffer
48          INTEGER bi, bj
49        INTEGER I, J , K, I_obc, J_obc        INTEGER I, J , K, I_obc, J_obc
50        _RL Tr_T, Ar_T, Tr, Ar        CHARACTER*(MAX_LEN_MBUF) msgBuf
51    #ifdef ALLOW_OBCS_BALANCE
52          _RL Tr_T, Ar_T, Tr, Ar
53    #endif /* ALLOW_OBCS_BALANCE */
54    #ifdef ALLOW_PTRACERS
55          INTEGER iTracer
56    #endif /* ALLOW_PTRACERS */
57    
58    
59    #ifdef ALLOW_DEBUG
60          IF ( debugLevel .GE. debLevB )
61         &     CALL DEBUG_ENTER('OBCS_CALC',myThid)
62    #endif
63    
64          DO bj=myByLo(myThid),myByHi(myThid)
65          DO bi=myBxLo(myThid),myBxHi(myThid)
66    
67  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
68  C     Eastern OB  C     Eastern OB
69    #ifdef ALLOW_DEBUG
70          IF ( debugLevel .GE. debLevB )
71         &     CALL DEBUG_MSG('OBCS_CALC: East',myThid)
72    #endif
73        IF (useOrlanskiEast) THEN        IF (useOrlanskiEast) THEN
74  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
75          CALL ORLANSKI_EAST(          CALL ORLANSKI_EAST(
76       &          bi, bj, futureTime,       &          bi, bj, futureTime,
77       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
78       &          myThid )       &          myThid )
79  #endif  #endif
80        ELSE        ELSE
# Line 73  C -------------------------------------- Line 102  C --------------------------------------
102    
103  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
104  C     Western OB  C     Western OB
105    #ifdef ALLOW_DEBUG
106          IF ( debugLevel .GE. debLevB )
107         &     CALL DEBUG_MSG('OBCS_CALC: West',myThid)
108    #endif
109        IF (useOrlanskiWest) THEN        IF (useOrlanskiWest) THEN
110  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
111          CALL ORLANSKI_WEST(          CALL ORLANSKI_WEST(
112       &          bi, bj, futureTime,       &          bi, bj, futureTime,
113       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
114       &          myThid )       &          myThid )
115  #endif  #endif
116        ELSE        ELSE
# Line 91  C     Western OB Line 124  C     Western OB
124                OBWs(J,K,bi,bj)=sRef(K)                OBWs(J,K,bi,bj)=sRef(K)
125  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
126                OBWw(J,K,bi,bj)=0.                OBWw(J,K,bi,bj)=0.
127  #endif  #endif
128  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
129                OBWeta(J,bi,bj)=0.                OBWeta(J,bi,bj)=0.
130  #endif  #endif
# Line 105  C -------------------------------------- Line 138  C --------------------------------------
138    
139  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
140  C         Northern OB  C         Northern OB
141    #ifdef ALLOW_DEBUG
142          IF ( debugLevel .GE. debLevB )
143         &     CALL DEBUG_MSG('OBCS_CALC: North',myThid)
144    #endif
145        IF (useOrlanskiNorth) THEN        IF (useOrlanskiNorth) THEN
146  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
147          CALL ORLANSKI_NORTH(          CALL ORLANSKI_NORTH(
148       &          bi, bj, futureTime,       &          bi, bj, futureTime,
149       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
150       &          myThid )       &          myThid )
151  #endif  #endif
152        ELSE        ELSE
# Line 125  C         Northern OB Line 162  C         Northern OB
162                OBNw(I,K,bi,bj)=0.                OBNw(I,K,bi,bj)=0.
163  #endif  #endif
164  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
165                OBNeta(J,bi,bj)=0.                OBNeta(I,bi,bj)=0.
166  #endif  #endif
167              ENDIF              ENDIF
168            ENDDO            ENDDO
# Line 137  C -------------------------------------- Line 174  C --------------------------------------
174    
175  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
176  C         Southern OB  C         Southern OB
177        IF (useOrlanskiSouth) THEN    #ifdef ALLOW_DEBUG
178          IF ( debugLevel .GE. debLevB )
179         &     CALL DEBUG_MSG('OBCS_CALC: South',myThid)
180    #endif
181          IF (useOrlanskiSouth) THEN
182  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
183          CALL ORLANSKI_SOUTH(          CALL ORLANSKI_SOUTH(
184       &          bi, bj, futureTime,       &          bi, bj, futureTime,
185       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
186       &          myThid )       &          myThid )
187  #endif  #endif
188        ELSE        ELSE
# Line 157  C         Southern OB Line 198  C         Southern OB
198                OBSw(I,K,bi,bj)=0.                OBSw(I,K,bi,bj)=0.
199  #endif  #endif
200  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
201                OBSeta(J,bi,bj)=0.                OBSeta(I,bi,bj)=0.
202  #endif  #endif
203              ENDIF              ENDIF
204            ENDDO            ENDDO
# Line 165  C         Southern OB Line 206  C         Southern OB
206        ENDIF        ENDIF
207  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
208    
209    #ifdef ALLOW_PTRACERS
210          IF ( usePTRACERS ) THEN
211    C
212    C     Calculate some default open boundary conditions for passive tracers:
213    C     The default is a homogeneous v.Neumann conditions, that is, the
214    C     tracer gradient across the open boundary is nearly zero;
215    C     only nearly, because the boundary conditions are applied throughout
216    C     the time step during which the interior field does change; therefore
217    C     we have to use the values from the previous time step here. If you
218    C     really want exact v.Neumann conditions, you have to modify
219    C     obcs_apply_ptracer directly.
220    C
221    # ifdef ALLOW_OBCS_EAST
222    C     Eastern OB
223    #  ifdef ALLOW_DEBUG
224           IF ( debugLevel .GE. debLevB )
225         &      CALL DEBUG_MSG('OBCS_CALC: East, pTracers',myThid)
226    #  endif
227           IF (useOrlanskiEast) THEN
228    #  ifdef ALLOW_ORLANSKI
229            WRITE(msgBuf,'(A)')
230         &       'OBCS_CALC: ERROR: useOrlanskiEast Rad OBC with'
231            CALL PRINT_ERROR( msgBuf, myThid )
232            WRITE(msgBuf,'(A)')
233         &       'OBCS_CALC: ERROR: pTracers not yet implemented'
234            CALL PRINT_ERROR( msgBuf, myThid )
235            STOP 'ABNORMAL END: S/R OBCS_CALC'
236    #  endif
237           ELSE
238            DO iTracer=1,PTRACERS_numInUse
239             DO K=1,Nr
240              DO J=1-Oly,sNy+Oly
241               I_obc=OB_Ie(J,bi,bj)
242               IF (I_obc.ne.0) THEN
243                OBEptr(J,K,bi,bj,iTracer) =
244         &           pTracer(I_obc-1,J,K,bi,bj,iTracer)
245         &           *_maskW(I_obc,J,K,bi,bj)
246               ENDIF
247              ENDDO
248             ENDDO
249            ENDDO
250           ENDIF
251    # endif /* ALLOW_OBCS_EAST */
252    
253    C ------------------------------------------------------------------------------
254    
255    # ifdef ALLOW_OBCS_WEST
256    C     Western OB
257    #  ifdef ALLOW_DEBUG
258           IF ( debugLevel .GE. debLevB )
259         &      CALL DEBUG_MSG('OBCS_CALC: West, pTracers',myThid)
260    #  endif
261           IF (useOrlanskiWest) THEN
262    #  ifdef ALLOW_ORLANSKI
263            WRITE(msgBuf,'(A)')
264         &       'OBCS_CALC: ERROR: useOrlanskiWest Rad OBC with'
265            CALL PRINT_ERROR( msgBuf, myThid )
266            WRITE(msgBuf,'(A)')
267         &       'OBCS_CALC: ERROR: pTracers not yet implemented'
268            CALL PRINT_ERROR( msgBuf, myThid )
269            STOP 'ABNORMAL END: S/R OBCS_CALC'
270    #  endif
271           ELSE
272            DO iTracer=1,PTRACERS_numInUse
273             DO K=1,Nr
274              DO J=1-Oly,sNy+Oly
275               I_obc=OB_Iw(J,bi,bj)
276               IF (I_obc.ne.0) THEN
277                OBWptr(J,K,bi,bj,iTracer) =
278         &           pTracer(I_obc+1,J,K,bi,bj,iTracer)
279         &           *_maskW(I_obc+1,J,K,bi,bj)
280               ENDIF
281              ENDDO
282             ENDDO
283            ENDDO
284           ENDIF
285    # endif /* ALLOW_OBCS_WEST */
286    
287    C ------------------------------------------------------------------------------
288    
289    # ifdef ALLOW_OBCS_NORTH
290    C         Northern OB
291    #  ifdef ALLOW_DEBUG
292           IF ( debugLevel .GE. debLevB )
293         &     CALL DEBUG_MSG('OBCS_CALC: North, pTracers',myThid)
294    #  endif
295           IF (useOrlanskiNorth) THEN
296    #  ifdef ALLOW_ORLANSKI
297            WRITE(msgBuf,'(A)')
298         &       'OBCS_CALC: ERROR: useOrlanskiNorth Rad OBC with'
299            CALL PRINT_ERROR( msgBuf, myThid )
300            WRITE(msgBuf,'(A)')
301         &       'OBCS_CALC: ERROR: pTracers not yet implemented'
302            CALL PRINT_ERROR( msgBuf, myThid )
303            STOP 'ABNORMAL END: S/R OBCS_CALC'
304    #  endif
305           ELSE
306            DO iTracer=1,PTRACERS_numInUse
307             DO K=1,Nr
308              DO I=1-Olx,sNx+Olx
309               J_obc=OB_Jn(I,bi,bj)
310               IF (J_obc.ne.0) THEN
311                OBNptr(I,K,bi,bj,iTracer) =
312         &           pTracer(I,J_obc-1,K,bi,bj,iTracer)
313         &           *_maskS(I,J_obc,K,bi,bj)
314               ENDIF
315              ENDDO
316             ENDDO
317            ENDDO
318           ENDIF
319    # endif /* ALLOW_OBCS_NORTH */
320    
321    C ------------------------------------------------------------------------------
322    
323    # ifdef ALLOW_OBCS_SOUTH
324    C         Southern OB
325    # ifdef ALLOW_DEBUG
326           IF ( debugLevel .GE. debLevB )
327         &      CALL DEBUG_MSG('OBCS_CALC: South, pTracers',myThid)
328    #endif
329           IF (useOrlanskiSouth) THEN
330    #ifdef ALLOW_ORLANSKI
331            WRITE(msgBuf,'(A)')
332         &       'OBCS_CALC: ERROR: useOrlanskiSouth Rad OBC with'
333            CALL PRINT_ERROR( msgBuf, myThid )
334            WRITE(msgBuf,'(A)')
335         &       'OBCS_CALC: ERROR: pTracers not yet implemented'
336            CALL PRINT_ERROR( msgBuf, myThid )
337            STOP 'ABNORMAL END: S/R OBCS_CALC'
338    #endif
339           ELSE
340            DO iTracer=1,PTRACERS_numInUse
341             DO K=1,Nr
342              DO I=1-Olx,sNx+Olx
343               J_obc=OB_Js(I,bi,bj)
344               IF (J_obc.ne.0) THEN
345                OBSptr(I,K,bi,bj,iTracer) =
346         &           pTracer(I,J_obc+1,K,bi,bj,iTracer)
347         &           *_maskS(I,J_obc+1,K,bi,bj)
348               ENDIF
349              ENDDO
350             ENDDO
351            ENDDO
352           ENDIF
353    # endif /* ALLOW_OBCS_SOUTH */
354    C     end if (usePTracers)
355          ENDIF
356    #endif /* ALLOW_PTRACERS */
357    
358    C--   end bi,bj loops.
359          ENDDO
360          ENDDO
361    
362  C ------------------------------------------------------------------------------  C ------------------------------------------------------------------------------
363    
364  #ifdef ALLOW_OBCS_PRESCRIBE  #ifdef ALLOW_OBCS_PRESCRIBE
365        IF (useOBCSprescribe) THEN        IF (useOBCSprescribe) THEN
366  C--     Calculate future values on open boundaries  C--     Calculate future values on open boundaries
367          CALL OBCS_PRESCRIBE_READ(futureTime, futureIter, mythid)  #ifdef ALLOW_DEBUG
368          IF ( debugLevel .GE. debLevB )
369         &      CALL DEBUG_CALL('OBCS_PRESCRIBE_READ',myThid)
370    #endif
371            CALL OBCS_PRESCRIBE_READ( futureTime, futureIter, myThid )
372        ENDIF        ENDIF
373  #endif /* ALLOW_OBCS_PRESCRIBE */  #endif /* ALLOW_OBCS_PRESCRIBE */
374    
# Line 179  C -------------------------------------- Line 376  C --------------------------------------
376    
377  #ifdef ALLOW_OBCS_BALANCE  #ifdef ALLOW_OBCS_BALANCE
378        IF ( useOBCSbalance) THEN        IF ( useOBCSbalance) THEN
379    #ifdef ALLOW_DEBUG
380           IF ( debugLevel .GE. debLevB )
381         &      CALL DEBUG_MSG('useOBCSbalance=.TRUE.',myThid)
382    #endif
383    
384  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
385          Tr_T = 0. _d 0         Tr_T = 0. _d 0
386          Ar_T = 0. _d 0         Ar_T = 0. _d 0
387          DO K=1,Nr         DO bj=myByLo(myThid),myByHi(myThid)
388            DO J=1-Oly,sNy+Oly          DO bi=myBxLo(myThid),myBxHi(myThid)
389              I_obc=OB_Ie(J,bi,bj)           DO K=1,Nr
390              IF (I_obc.ne.0) THEN            DO J=1,sNy
391                Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)             I_obc=OB_Ie(J,bi,bj)
392                Ar_T = Ar_T + Ar             IF (I_obc.ne.0) THEN
393                Tr_T = Tr_T + Ar * OBEu(J,K,bi,bj)              Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)
394              ENDIF              Ar_T = Ar_T + Ar
395                Tr_T = Tr_T + Ar * OBEu(J,K,bi,bj)
396               ENDIF
397            ENDDO            ENDDO
398             ENDDO
399          ENDDO          ENDDO
400          _GLOBAL_SUM_R8( Ar_T , myThid )         ENDDO
401          _GLOBAL_SUM_R8( Tr_T , myThid )         _GLOBAL_SUM_RL( Ar_T , myThid )
402           IF ( Ar_T .GT. 0. _d 0 ) THEN
403            _GLOBAL_SUM_RL( Tr_T , myThid )
404          Tr_T = (0. - Tr_T)/Ar_T          Tr_T = (0. - Tr_T)/Ar_T
405          DO K=1,Nr          DO bj=myByLo(myThid),myByHi(myThid)
406            DO J=1-Oly,sNy+Oly           DO bi=myBxLo(myThid),myBxHi(myThid)
407              DO K=1,Nr
408               DO J=1-Oly,sNy+Oly
409              I_obc=OB_Ie(J,bi,bj)              I_obc=OB_Ie(J,bi,bj)
410              IF (I_obc.ne.0) THEN              IF (I_obc.ne.0) THEN
411                OBEu(J,K,bi,bj) = OBEu(J,K,bi,bj) + Tr_T               OBEu(J,K,bi,bj) = OBEu(J,K,bi,bj) + Tr_T
412  c              OBEv(J,K,bi,bj) = 0.  c            OBEv(J,K,bi,bj) = 0.
413              ENDIF              ENDIF
414               ENDDO
415            ENDDO            ENDDO
416             ENDDO
417          ENDDO          ENDDO
418           ENDIF
419  #endif  #endif
420    
421  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
422          Tr_T = 0. _d 0         Tr_T = 0. _d 0
423          Ar_T = 0. _d 0         Ar_T = 0. _d 0
424          DO K=1,Nr         DO bj=myByLo(myThid),myByHi(myThid)
425            DO J=1-Oly,sNy+Oly          DO bi=myBxLo(myThid),myBxHi(myThid)
426              I_obc=OB_Iw(J,bi,bj)           DO K=1,Nr
427              IF (I_obc.ne.0) THEN            DO J=1,sNy
428                Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)             I_obc=OB_Iw(J,bi,bj)
429                Ar_T = Ar_T + Ar             IF (I_obc.ne.0) THEN
430                Tr_T = Tr_T + Ar * OBWu(J,K,bi,bj)              Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)
431              ENDIF              Ar_T = Ar_T + Ar
432                Tr_T = Tr_T + Ar * OBWu(J,K,bi,bj)
433               ENDIF
434            ENDDO            ENDDO
435             ENDDO
436          ENDDO          ENDDO
437          _GLOBAL_SUM_R8( Ar_T , myThid )         ENDDO
438          _GLOBAL_SUM_R8( Tr_T , myThid )         _GLOBAL_SUM_RL( Ar_T , myThid )
439           IF ( Ar_T .GT. 0. _d 0 ) THEN
440            _GLOBAL_SUM_RL( Tr_T , myThid )
441          Tr_T = (0. - Tr_T)/Ar_T          Tr_T = (0. - Tr_T)/Ar_T
442          DO K=1,Nr          DO bj=myByLo(myThid),myByHi(myThid)
443            DO J=1-Oly,sNy+Oly           DO bi=myBxLo(myThid),myBxHi(myThid)
444              DO K=1,Nr
445               DO J=1-Oly,sNy+Oly
446              I_obc=OB_Iw(J,bi,bj)              I_obc=OB_Iw(J,bi,bj)
447              IF (I_obc.ne.0) THEN              IF (I_obc.ne.0) THEN
448                  OBWu(J,K,bi,bj) = OBWu(J,K,bi,bj) + Tr_T               OBWu(J,K,bi,bj) = OBWu(J,K,bi,bj) + Tr_T
449  c                OBWv(J,K,bi,bj) = 0.  c            OBWv(J,K,bi,bj) = 0.
450              ENDIF              ENDIF
451               ENDDO
452            ENDDO            ENDDO
453             ENDDO
454          ENDDO          ENDDO
455           ENDIF
456  #endif  #endif
457    
458  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
459          Tr_T = 0. _d 0         Tr_T = 0. _d 0
460          Ar_T = 0. _d 0         Ar_T = 0. _d 0
461          DO K=1,Nr         DO bj=myByLo(myThid),myByHi(myThid)
462            DO I=1-Olx,sNx+Olx          DO bi=myBxLo(myThid),myBxHi(myThid)
463              J_obc=OB_Jn(I,bi,bj)           DO K=1,Nr
464              IF (J_obc.ne.0) THEN            DO I=1,sNx
465                Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)             J_obc=OB_Jn(I,bi,bj)
466                Ar_T = Ar_T + Ar             IF (J_obc.ne.0) THEN
467                Tr_T = Tr_T + Ar * OBNv(I,K,bi,bj)              Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)
468              ENDIF              Ar_T = Ar_T + Ar
469                Tr_T = Tr_T + Ar * OBNv(I,K,bi,bj)
470               ENDIF
471            ENDDO            ENDDO
472             ENDDO
473          ENDDO          ENDDO
474          _GLOBAL_SUM_R8( Ar_T , myThid )         ENDDO
475          _GLOBAL_SUM_R8( Tr_T , myThid )         _GLOBAL_SUM_RL( Ar_T , myThid )
476           IF ( Ar_T .GT. 0. _d 0 ) THEN
477            _GLOBAL_SUM_RL( Tr_T , myThid )
478          Tr_T = (0. - Tr_T)/Ar_T          Tr_T = (0. - Tr_T)/Ar_T
479          DO K=1,Nr          DO bj=myByLo(myThid),myByHi(myThid)
480            DO I=1-Olx,sNx+Olx           DO bi=myBxLo(myThid),myBxHi(myThid)
481              DO K=1,Nr
482               DO I=1-Olx,sNx+Olx
483              J_obc=OB_Jn(I,bi,bj)              J_obc=OB_Jn(I,bi,bj)
484              IF (J_obc.ne.0) THEN              IF (J_obc.ne.0) THEN
485  c                OBNu(I,K,bi,bj) = 0.  c            OBNu(I,K,bi,bj) = 0.
486                  OBNv(I,K,bi,bj) = OBNv(I,K,bi,bj) + Tr_T               OBNv(I,K,bi,bj) = OBNv(I,K,bi,bj) + Tr_T
487              ENDIF              ENDIF
488               ENDDO
489            ENDDO            ENDDO
490             ENDDO
491          ENDDO          ENDDO
492           ENDIF
493  #endif  #endif
494    
495  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
496          Tr_T = 0. _d 0         Tr_T = 0. _d 0
497          Ar_T = 0. _d 0         Ar_T = 0. _d 0
498          DO K=1,Nr         DO bj=myByLo(myThid),myByHi(myThid)
499            DO I=1-Olx,sNx+Olx          DO bi=myBxLo(myThid),myBxHi(myThid)
500              J_obc=OB_Js(I,bi,bj)           DO K=1,Nr
501              IF (J_obc.ne.0) THEN            DO I=1,sNx
502                Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)             J_obc=OB_Js(I,bi,bj)
503                Ar_T = Ar_T + Ar             IF (J_obc.ne.0) THEN
504                Tr_T = Tr_T + Ar * OBSv(I,K,bi,bj)              Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)
505              ENDIF              Ar_T = Ar_T + Ar
506                Tr_T = Tr_T + Ar * OBSv(I,K,bi,bj)
507               ENDIF
508            ENDDO            ENDDO
509             ENDDO
510          ENDDO          ENDDO
511          _GLOBAL_SUM_R8( Ar_T , myThid )         ENDDO
512          _GLOBAL_SUM_R8( Tr_T , myThid )         _GLOBAL_SUM_RL( Ar_T , myThid )
513           IF ( Ar_T .GT. 0. _d 0 ) THEN
514            _GLOBAL_SUM_RL( Tr_T , myThid )
515          Tr_T = (0. - Tr_T)/Ar_T          Tr_T = (0. - Tr_T)/Ar_T
516          DO K=1,Nr          DO bj=myByLo(myThid),myByHi(myThid)
517            DO I=1-Olx,sNx+Olx           DO bi=myBxLo(myThid),myBxHi(myThid)
518              DO K=1,Nr
519               DO I=1-Olx,sNx+Olx
520              J_obc=OB_Js(I,bi,bj)              J_obc=OB_Js(I,bi,bj)
521              IF (J_obc.ne.0) THEN              IF (J_obc.ne.0) THEN
522  c                OBSu(I,K,bi,bj) = 0.  c            OBSu(I,K,bi,bj) = 0.
523                  OBSv(I,K,bi,bj) = OBSv(I,K,bi,bj) + Tr_T               OBSv(I,K,bi,bj) = OBSv(I,K,bi,bj) + Tr_T
524              ENDIF              ENDIF
525               ENDDO
526            ENDDO            ENDDO
527             ENDDO
528          ENDDO          ENDDO
529           ENDIF
530  #endif  #endif
531    
532        ENDIF        ENDIF
# Line 293  c                OBSu(I,K,bi,bj) = 0. Line 534  c                OBSu(I,K,bi,bj) = 0.
534    
535  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
536    
537    #ifdef ALLOW_DEBUG
538          IF ( debugLevel .GE. debLevB )
539         &     CALL DEBUG_LEAVE('OBCS_CALC',myThid)
540    #endif
541        RETURN        RETURN
542        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22