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

Annotation of /MITgcm/pkg/obcs/obcs_apply_uv.F

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

Revision 1.8 - (hide annotations) (download)
Tue Sep 18 20:09:17 2012 UTC (11 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.7: +17 -17 lines 
use new parameter OB_indexNone for null index value (instead of hard-coded 0)
1 jmc 1.8 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uv.F,v 1.7 2011/05/24 14:31:14 jmc Exp $
2 heimbach 1.3 C $Name: $
3 adcroft 1.2
4     #include "OBCS_OPTIONS.h"
5    
6 jmc 1.4 CBOP
7     C !ROUTINE: OBCS_APPLY_UV
8     C !INTERFACE:
9     SUBROUTINE OBCS_APPLY_UV( bi, bj, kArg,
10 adcroft 1.2 U uFld, vFld,
11     I myThid )
12 jmc 1.4
13     C !DESCRIPTION:
14     C *==========================================================*
15     C | S/R OBCS_APPLY_UV
16     C *==========================================================*
17    
18     C !USES:
19 adcroft 1.2 IMPLICIT NONE
20     C == Global variables ==
21     #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "PARAMS.h"
24     #include "GRID.h"
25 jmc 1.7 #include "OBCS_PARAMS.h"
26     #include "OBCS_GRID.h"
27     #include "OBCS_FIELDS.h"
28 adcroft 1.2
29 jmc 1.4 C !INPUT/OUTPUT PARAMETERS:
30 adcroft 1.2 C == Routine Arguments ==
31 jmc 1.4 C bi, bj :: indices of current tile
32     C kArg :: index of current level which OBC applies to
33     C or, if zero, apply to all levels
34     C uFld :: horizontal velocity field, 1rst component (zonal)
35     C vFld :: horizontal velocity field, 2nd component (meridional)
36     C myThid :: my Thread Id number
37     c INTEGER biArg, bjArg
38     INTEGER bi, bj
39     INTEGER kArg
40 adcroft 1.2 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
41     _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
42     INTEGER myThid
43 jmc 1.4 CEOP
44 adcroft 1.2
45     #ifdef ALLOW_OBCS
46    
47 jmc 1.4 C !LOCAL VARIABLES:
48 adcroft 1.2 C == Local variables ==
49 jmc 1.4 c INTEGER bi, bj, itLo, itHi, jtLo, jtHi
50     INTEGER k, kLo, kHi
51     INTEGER i, j
52     INTEGER Iobc, Jobc
53    
54 jmc 1.5 C-- Set model variables to OB values on North/South Boundaries:
55     C 2 steps: 1) set tangential component ; 2) set normal component.
56     C This ensures that the normal component is set correctly even
57     C when it conficts with tangential setting from an other OB.
58    
59 jmc 1.4 c IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
60     c itLo = myBxLo(myThid)
61     c itHi = myBxHi(myThid)
62     c jtLo = myByLo(myThid)
63     c jtHi = myByHi(myThid)
64     c ELSE
65     c itLo = biArg
66     c itHi = biArg
67     c jtLo = bjArg
68     c jtHi = bjArg
69     c ENDIF
70     IF ( kArg.EQ.0 ) THEN
71     kLo = 1
72     kHi = Nr
73     ELSE
74     kLo = kArg
75     kHi = kArg
76     ENDIF
77    
78     c DO bj = jtLo,jtHi
79     c DO bi = itLo,itHi
80 adcroft 1.2
81 jmc 1.5 C-- Set Tangential component first:
82    
83     #ifdef ALLOW_OBCS_NORTH
84     IF ( tileHasOBN(bi,bj) ) THEN
85     C Northern boundary
86 jmc 1.8 DO i=1-OLx,sNx+OLx
87 jmc 1.5 Jobc = OB_Jn(i,bi,bj)
88 jmc 1.8 IF ( Jobc.NE.OB_indexNone ) THEN
89 jmc 1.5 DO k = kLo,kHi
90     uFld(i,Jobc,k,bi,bj) = OBNu(i,k,bi,bj)
91     & *_maskW(i,Jobc,k,bi,bj)
92     ENDDO
93     ENDIF
94     ENDDO
95     ENDIF
96     #endif
97     #ifdef ALLOW_OBCS_SOUTH
98     IF ( tileHasOBS(bi,bj) ) THEN
99     C Southern boundary
100 jmc 1.8 DO i=1-OLx,sNx+OLx
101 jmc 1.5 Jobc = OB_Js(i,bi,bj)
102 jmc 1.8 IF ( Jobc.NE.OB_indexNone ) THEN
103 jmc 1.5 DO k = kLo,kHi
104     uFld(i,Jobc,k,bi,bj) = OBSu(i,k,bi,bj)
105     & *_maskW(i,Jobc,k,bi,bj)
106     ENDDO
107     ENDIF
108     ENDDO
109     ENDIF
110     #endif
111    
112     C Set model variables to OB values on East/West Boundaries
113     #ifdef ALLOW_OBCS_EAST
114     IF ( tileHasOBE(bi,bj) ) THEN
115     C Eastern boundary
116 jmc 1.8 DO j=1-OLy,sNy+OLy
117 jmc 1.5 Iobc = OB_Ie(j,bi,bj)
118 jmc 1.8 IF ( Iobc.NE.OB_indexNone ) THEN
119 jmc 1.5 DO k = kLo,kHi
120     vFld(Iobc,j,k,bi,bj) = OBEv(j,k,bi,bj)
121     & *_maskS(Iobc,j,k,bi,bj)
122     ENDDO
123     ENDIF
124     ENDDO
125     ENDIF
126     #endif
127     #ifdef ALLOW_OBCS_WEST
128     IF ( tileHasOBW(bi,bj) ) THEN
129     C Western boundary
130 jmc 1.8 DO j=1-OLy,sNy+OLy
131 jmc 1.5 Iobc = OB_Iw(j,bi,bj)
132 jmc 1.8 IF ( Iobc.NE.OB_indexNone ) THEN
133 jmc 1.5 DO k = kLo,kHi
134     vFld(Iobc,j,k,bi,bj) = OBWv(j,k,bi,bj)
135     & *_maskS(Iobc,j,k,bi,bj)
136     ENDDO
137     ENDIF
138     ENDDO
139     ENDIF
140     #endif
141    
142     C-- Then set Normal component:
143    
144 heimbach 1.3 #ifdef ALLOW_OBCS_NORTH
145 jmc 1.4 IF ( tileHasOBN(bi,bj) ) THEN
146 adcroft 1.2 C Northern boundary
147 jmc 1.8 DO i=1-OLx,sNx+OLx
148 jmc 1.4 Jobc = OB_Jn(i,bi,bj)
149 jmc 1.8 IF ( Jobc.NE.OB_indexNone ) THEN
150 jmc 1.4 DO k = kLo,kHi
151 jmc 1.5 vFld(i,Jobc,k,bi,bj) = OBNv(i,k,bi,bj)
152 jmc 1.4 & *_maskS(i,Jobc,k,bi,bj)
153     vFld(i,Jobc+1,k,bi,bj) = OBNv(i,k,bi,bj)
154     & *_maskS(i,Jobc,k,bi,bj)
155 jmc 1.6 & *OBCS_uvApplyFac
156 jmc 1.4 ENDDO
157     ENDIF
158     ENDDO
159     ENDIF
160 heimbach 1.3 #endif
161     #ifdef ALLOW_OBCS_SOUTH
162 jmc 1.4 IF ( tileHasOBS(bi,bj) ) THEN
163 adcroft 1.2 C Southern boundary
164 jmc 1.8 DO i=1-OLx,sNx+OLx
165 jmc 1.4 Jobc = OB_Js(i,bi,bj)
166 jmc 1.8 IF ( Jobc.NE.OB_indexNone ) THEN
167 jmc 1.4 DO k = kLo,kHi
168     vFld(i,Jobc+1,k,bi,bj) = OBSv(i,k,bi,bj)
169     & *_maskS(i,Jobc+1,k,bi,bj)
170 jmc 1.5 vFld(i,Jobc,k,bi,bj) = OBSv(i,k,bi,bj)
171 jmc 1.4 & *_maskS(i,Jobc+1,k,bi,bj)
172 jmc 1.6 & *OBCS_uvApplyFac
173 jmc 1.4 ENDDO
174     ENDIF
175     ENDDO
176     ENDIF
177 heimbach 1.3 #endif
178 adcroft 1.2
179     C Set model variables to OB values on East/West Boundaries
180 heimbach 1.3 #ifdef ALLOW_OBCS_EAST
181 jmc 1.4 IF ( tileHasOBE(bi,bj) ) THEN
182 adcroft 1.2 C Eastern boundary
183 jmc 1.8 DO j=1-OLy,sNy+OLy
184 jmc 1.4 Iobc = OB_Ie(j,bi,bj)
185 jmc 1.8 IF ( Iobc.NE.OB_indexNone ) THEN
186 jmc 1.4 DO k = kLo,kHi
187 jmc 1.5 uFld(Iobc,j,k,bi,bj) = OBEu(j,k,bi,bj)
188 jmc 1.4 & *_maskW(Iobc,j,k,bi,bj)
189     uFld(Iobc+1,j,k,bi,bj) = OBEu(j,K,bi,bj)
190     & *_maskW(Iobc,j,k,bi,bj)
191 jmc 1.6 & *OBCS_uvApplyFac
192 jmc 1.4 ENDDO
193     ENDIF
194     ENDDO
195     ENDIF
196 heimbach 1.3 #endif
197     #ifdef ALLOW_OBCS_WEST
198 jmc 1.4 IF ( tileHasOBW(bi,bj) ) THEN
199 adcroft 1.2 C Western boundary
200 jmc 1.8 DO j=1-OLy,sNy+OLy
201 jmc 1.4 Iobc = OB_Iw(j,bi,bj)
202 jmc 1.8 IF ( Iobc.NE.OB_indexNone ) THEN
203 jmc 1.4 DO k = kLo,kHi
204     uFld(Iobc+1,j,k,bi,bj) = OBWu(j,k,bi,bj)
205     & *_maskW(Iobc+1,j,k,bi,bj)
206 jmc 1.5 uFld(Iobc,j,k,bi,bj) = OBWu(j,k,bi,bj)
207 jmc 1.4 & *_maskW(Iobc+1,j,k,bi,bj)
208 jmc 1.6 & *OBCS_uvApplyFac
209 jmc 1.4 ENDDO
210     ENDIF
211     ENDDO
212     ENDIF
213 heimbach 1.3 #endif
214 adcroft 1.2
215 jmc 1.4 c ENDDO
216     c ENDDO
217    
218     #endif /* ALLOW_OBCS */
219    
220 adcroft 1.2 RETURN
221     END
  ViewVC Help
Powered by ViewVC 1.1.22