/[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.6 by jmc, Fri Feb 8 22:16:09 2002 UTC revision 1.10 by heimbach, Tue Oct 12 18:37:38 2004 UTC
# Line 6  C $Name$ Line 6  C $Name$
6        SUBROUTINE OBCS_CALC( bi, bj, futureTime, futureIter,        SUBROUTINE OBCS_CALC( bi, bj, 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                                     |
11  C     | o Calculate future boundary data at open boundaries      |  C     | o Calculate future boundary data at open boundaries      |
12  C     |   at time = futureTime                                   |  C     |   at time = futureTime                                   |
13  C     |==========================================================|  C     |==========================================================|
14  C     |                                                          |  C     |                                                          |
15  C     \==========================================================/  C     |==========================================================|
16        IMPLICIT NONE        IMPLICIT NONE
17    
18  C     === Global variables ===  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"
23  #include "OBCS.h"  #include "OBCS.h"
24    
25  C     == Routine arguments ==  C     == Routine arguments ==
# Line 36  C     == Routine arguments == Line 37  C     == Routine arguments ==
37    
38  C     == Local variables ==  C     == Local variables ==
39        INTEGER I, J , K, I_obc, J_obc        INTEGER I, J , K, I_obc, J_obc
40          _RL Tr_T, Ar_T, Tr, Ar
41    
42    #ifdef ALLOW_OBCS_EAST
43  C     Eastern OB  C     Eastern OB
44        IF (useOrlanskiEast) THEN        IF (useOrlanskiEast) THEN
45    #ifdef ALLOW_ORLANSKI
46          CALL ORLANSKI_EAST(          CALL ORLANSKI_EAST(
47       &          bi, bj, futureTime,       &          bi, bj, futureTime,
48       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
49       &          myThid )       &          myThid )
50    #endif
51        ELSE        ELSE
52          DO K=1,Nr          DO K=1,Nr
53            DO J=1-Oly,sNy+Oly            DO J=1-Oly,sNy+Oly
# Line 62  C     Eastern OB Line 67  C     Eastern OB
67            ENDDO            ENDDO
68          ENDDO          ENDDO
69        ENDIF        ENDIF
70    #endif /* ALLOW_OBCS_EAST */
71    
72    C ------------------------------------------------------------------------------
73    
74    #ifdef ALLOW_OBCS_WEST
75  C     Western OB  C     Western OB
76        IF (useOrlanskiWest) THEN        IF (useOrlanskiWest) THEN
77    #ifdef ALLOW_ORLANSKI
78          CALL ORLANSKI_WEST(          CALL ORLANSKI_WEST(
79       &          bi, bj, futureTime,       &          bi, bj, futureTime,
80       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
81       &          myThid )       &          myThid )
82    #endif
83        ELSE        ELSE
84          DO K=1,Nr          DO K=1,Nr
85            DO J=1-Oly,sNy+Oly            DO J=1-Oly,sNy+Oly
# Line 80  C     Western OB Line 91  C     Western OB
91                OBWs(J,K,bi,bj)=sRef(K)                OBWs(J,K,bi,bj)=sRef(K)
92  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
93                OBWw(J,K,bi,bj)=0.                OBWw(J,K,bi,bj)=0.
94  #endif  #endif
95  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
96                OBWeta(J,bi,bj)=0.                OBWeta(J,bi,bj)=0.
97  #endif  #endif
98              ENDIF             ENDIF
99            ENDDO            ENDDO
100          ENDDO          ENDDO
101        ENDIF        ENDIF
102    #endif /* ALLOW_OBCS_WEST */
103    
104    C ------------------------------------------------------------------------------
105    
106    #ifdef ALLOW_OBCS_NORTH
107  C         Northern OB  C         Northern OB
108        IF (useOrlanskiNorth) THEN        IF (useOrlanskiNorth) THEN
109    #ifdef ALLOW_ORLANSKI
110          CALL ORLANSKI_NORTH(          CALL ORLANSKI_NORTH(
111       &          bi, bj, futureTime,       &          bi, bj, futureTime,
112       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
113       &          myThid )       &          myThid )
114    #endif
115        ELSE        ELSE
116          DO K=1,Nr          DO K=1,Nr
117            DO I=1-Olx,sNx+Olx            DO I=1-Olx,sNx+Olx
# Line 108  C         Northern OB Line 125  C         Northern OB
125                OBNw(I,K,bi,bj)=0.                OBNw(I,K,bi,bj)=0.
126  #endif  #endif
127  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
128                OBNeta(I,bi,bj)=0.                OBNeta(J,bi,bj)=0.
129  #endif  #endif
130              ENDIF              ENDIF
131            ENDDO            ENDDO
132          ENDDO          ENDDO
133        ENDIF        ENDIF
134    #endif /* ALLOW_OBCS_NORTH */
135    
136    C ------------------------------------------------------------------------------
137    
138    #ifdef ALLOW_OBCS_SOUTH
139  C         Southern OB  C         Southern OB
140        IF (useOrlanskiSouth) THEN          IF (useOrlanskiSouth) THEN  
141    #ifdef ALLOW_ORLANSKI
142          CALL ORLANSKI_SOUTH(          CALL ORLANSKI_SOUTH(
143       &          bi, bj, futureTime,       &          bi, bj, futureTime,
144       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
145       &          myThid )       &          myThid )
146    #endif
147        ELSE        ELSE
148          DO K=1,Nr          DO K=1,Nr
149            DO I=1-Olx,sNx+Olx            DO I=1-Olx,sNx+Olx
# Line 134  C         Southern OB Line 157  C         Southern OB
157                OBSw(I,K,bi,bj)=0.                OBSw(I,K,bi,bj)=0.
158  #endif  #endif
159  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
160                OBSeta(I,bi,bj)=0.                OBSeta(J,bi,bj)=0.
161    #endif
162                ENDIF
163              ENDDO
164            ENDDO
165          ENDIF
166    #endif /* ALLOW_OBCS_SOUTH */
167    
168    
169    C ------------------------------------------------------------------------------
170    
171    #ifdef ALLOW_OBCS_PRESCRIBE
172          IF (useOBCSprescribe) THEN
173    C--     Calculate future values on open boundaries
174            CALL OBCS_PRESCRIBE_READ(futureTime, futureIter, mythid)
175          ENDIF
176    #endif /* ALLOW_OBCS_PRESCRIBE */
177    
178    C ------------------------------------------------------------------------------
179    
180    #ifdef ALLOW_OBCS_BALANCE
181          IF ( useOBCSbalance) THEN
182    
183    #ifdef ALLOW_OBCS_EAST
184            Tr_T = 0. _d 0
185            Ar_T = 0. _d 0
186            DO K=1,Nr
187              DO J=1-Oly,sNy+Oly
188                I_obc=OB_Ie(J,bi,bj)
189                IF (I_obc.ne.0) THEN
190                  Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)
191                  Ar_T = Ar_T + Ar
192                  Tr_T = Tr_T + Ar * OBEu(J,K,bi,bj)
193                ENDIF
194              ENDDO
195            ENDDO
196            _GLOBAL_SUM_R8( Ar_T , myThid )
197            _GLOBAL_SUM_R8( Tr_T , myThid )
198            Tr_T = (0. - Tr_T)/Ar_T
199            DO K=1,Nr
200              DO J=1-Oly,sNy+Oly
201                I_obc=OB_Ie(J,bi,bj)
202                IF (I_obc.ne.0) THEN
203                  OBEu(J,K,bi,bj) = OBEu(J,K,bi,bj) + Tr_T
204    c              OBEv(J,K,bi,bj) = 0.
205                ENDIF
206              ENDDO
207            ENDDO
208    #endif
209    
210    #ifdef ALLOW_OBCS_WEST
211            Tr_T = 0. _d 0
212            Ar_T = 0. _d 0
213            DO K=1,Nr
214              DO J=1-Oly,sNy+Oly
215                I_obc=OB_Iw(J,bi,bj)
216                IF (I_obc.ne.0) THEN
217                  Ar = drF(k)*hFacC(I_obc,j,k,bi,bj)*dyG(I_obc,j,bi,bj)
218                  Ar_T = Ar_T + Ar
219                  Tr_T = Tr_T + Ar * OBWu(J,K,bi,bj)
220                ENDIF
221              ENDDO
222            ENDDO
223            _GLOBAL_SUM_R8( Ar_T , myThid )
224            _GLOBAL_SUM_R8( Tr_T , myThid )
225            Tr_T = (0. - Tr_T)/Ar_T
226            DO K=1,Nr
227              DO J=1-Oly,sNy+Oly
228                I_obc=OB_Iw(J,bi,bj)
229                IF (I_obc.ne.0) THEN
230                    OBWu(J,K,bi,bj) = OBWu(J,K,bi,bj) + Tr_T
231    c                OBWv(J,K,bi,bj) = 0.
232                ENDIF
233              ENDDO
234            ENDDO
235    #endif
236    
237    #ifdef ALLOW_OBCS_NORTH
238            Tr_T = 0. _d 0
239            Ar_T = 0. _d 0
240            DO K=1,Nr
241              DO I=1-Olx,sNx+Olx
242                J_obc=OB_Jn(I,bi,bj)
243                IF (J_obc.ne.0) THEN
244                  Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)
245                  Ar_T = Ar_T + Ar
246                  Tr_T = Tr_T + Ar * OBNv(I,K,bi,bj)
247                ENDIF
248              ENDDO
249            ENDDO
250            _GLOBAL_SUM_R8( Ar_T , myThid )
251            _GLOBAL_SUM_R8( Tr_T , myThid )
252            Tr_T = (0. - Tr_T)/Ar_T
253            DO K=1,Nr
254              DO I=1-Olx,sNx+Olx
255                J_obc=OB_Jn(I,bi,bj)
256                IF (J_obc.ne.0) THEN
257    c                OBNu(I,K,bi,bj) = 0.
258                    OBNv(I,K,bi,bj) = OBNv(I,K,bi,bj) + Tr_T
259                ENDIF
260              ENDDO
261            ENDDO
262  #endif  #endif
263    
264    #ifdef ALLOW_OBCS_SOUTH
265            Tr_T = 0. _d 0
266            Ar_T = 0. _d 0
267            DO K=1,Nr
268              DO I=1-Olx,sNx+Olx
269                J_obc=OB_Js(I,bi,bj)
270                IF (J_obc.ne.0) THEN
271                  Ar = drF(k)*hFacC(i,J_obc,k,bi,bj)*dxG(i,J_obc,bi,bj)
272                  Ar_T = Ar_T + Ar
273                  Tr_T = Tr_T + Ar * OBSv(I,K,bi,bj)
274              ENDIF              ENDIF
275            ENDDO            ENDDO
276          ENDDO          ENDDO
277            _GLOBAL_SUM_R8( Ar_T , myThid )
278            _GLOBAL_SUM_R8( Tr_T , myThid )
279            Tr_T = (0. - Tr_T)/Ar_T
280            DO K=1,Nr
281              DO I=1-Olx,sNx+Olx
282                J_obc=OB_Js(I,bi,bj)
283                IF (J_obc.ne.0) THEN
284    c                OBSu(I,K,bi,bj) = 0.
285                    OBSv(I,K,bi,bj) = OBSv(I,K,bi,bj) + Tr_T
286                ENDIF
287              ENDDO
288            ENDDO
289    #endif
290    
291        ENDIF        ENDIF
292    #endif /* ALLOW_OBCS_BALANCE */
293    
294  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
295    
296        RETURN        RETURN
297        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22