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

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

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

Revision 1.8 - (hide annotations) (download)
Sat Jan 19 01:57:11 2008 UTC (16 years, 4 months ago) by dimitri
Branch: MAIN
Changes since 1.7: +61 -44 lines 
Some options have been added to obcs_apply_seaice.F and obcs_apply_uvice.F,
currently controlled via CPP until they have been more fully tested.  The
issue being addressed is how best to deal with instabilities caused by
low-frequency specification of seaice boundary conditions.
1 dimitri 1.8 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uvice.F,v 1.7 2008/01/17 20:48:07 dimitri Exp $
2 dimitri 1.1 C $Name: $
3    
4 dimitri 1.8 #undef OBCS_SEAICE_SMOOTH_UVICE_PERP
5     #undef OBCS_SEAICE_SMOOTH_UVICE_PAR
6 dimitri 1.7 #undef OBCS_SEAICE_COMPUTE_UVICE
7    
8 dimitri 1.1 #include "OBCS_OPTIONS.h"
9    
10 dimitri 1.2 SUBROUTINE OBCS_APPLY_UVICE(
11 dimitri 1.4 U uFld, vFld,
12 dimitri 1.1 I myThid )
13     C /==========================================================\
14     C | S/R OBCS_APPLY_UVICE |
15     C \==========================================================/
16     IMPLICIT NONE
17     C == Global variables ==
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "GRID.h"
22     #include "OBCS.h"
23    
24     C == Routine Arguments ==
25     _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
26     _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
27     INTEGER myThid
28    
29     #if (defined (ALLOW_OBCS) && defined (ALLOW_SEAICE))
30    
31     C == Local variables ==
32 dimitri 1.2 C I,J,K,bi,bj - Loop counters
33     INTEGER I,J,K,bi,bj
34     K = 1
35 dimitri 1.1
36 dimitri 1.2 DO bj=myByLo(myThid),myByHi(myThid)
37     DO bi=myBxLo(myThid),myBxHi(myThid)
38 dimitri 1.1
39     C Set model variables to OB values on North/South Boundaries
40     #ifdef ALLOW_OBCS_NORTH
41 dimitri 1.5 if ( OBNvicefile .NE. ' ' ) then
42 dimitri 1.1 DO I=1-Olx,sNx+Olx
43 dimitri 1.4 C Northern boundary
44 dimitri 1.1 IF (OB_Jn(I,bi,bj).NE.0) THEN
45 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
46     vFld(I,OB_Jn(I,bi,bj) ,1,bi,bj) =
47     & _maskS(I,OB_Jn(I,bi,bj),K,bi,bj) *
48     & vFld(I,OB_Jn(I,bi,bj)-1,1,bi,bj)
49     #else
50 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
51     vFld(I,OB_Jn(I,bi,bj),1,bi,bj)=
52     & max(OBNvice(I,bi,bj),vFld(I,OB_Jn(I,bi,bj),1,bi,bj))
53     & * _maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
54     #else
55 dimitri 1.1 vFld(I,OB_Jn(I,bi,bj),1,bi,bj)=OBNvice(I,bi,bj)
56     & *_maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
57 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
58 dimitri 1.1 uFld(I,OB_Jn(I,bi,bj),1,bi,bj)=OBNuice(I,bi,bj)
59     & *_maskW(I,OB_Jn(I,bi,bj),K,bi,bj)
60 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
61 dimitri 1.7 if ( _maskS(I,OB_Jn(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
62     & _maskS(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
63 dimitri 1.8 & vFld(I,OB_Jn(I,bi,bj)-1,1,bi,bj) = 0.5 _d 0 *
64     & ( vFld(I,OB_Jn(I,bi,bj) ,1,bi,bj) +
65     & vFld(I,OB_Jn(I,bi,bj)-2,1,bi,bj) ) *
66     & _maskS(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
67     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
68     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
69     if ( _maskW(I,OB_Jn(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
70     & _maskW(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
71     & uFld(I,OB_Jn(I,bi,bj)-1,1,bi,bj) = 0.5 _d 0 *
72     & ( uFld(I,OB_Jn(I,bi,bj) ,1,bi,bj) +
73     & uFld(I,OB_Jn(I,bi,bj)-2,1,bi,bj) ) *
74     & _maskW(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
75     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
76 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
77 dimitri 1.1 ENDIF
78     ENDDO
79 dimitri 1.5 endif
80 dimitri 1.7 #endif /* ALLOW_OBCS_NORTH */
81 dimitri 1.1 #ifdef ALLOW_OBCS_SOUTH
82 dimitri 1.5 if ( OBSvicefile .NE. ' ' ) then
83 dimitri 1.1 DO I=1-Olx,sNx+Olx
84 dimitri 1.4 C Southern boundary
85 dimitri 1.1 IF (OB_Js(I,bi,bj).NE.0) THEN
86 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
87     vFld(I,OB_Js(I,bi,bj)+1,1,bi,bj) =
88     & _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) *
89     & vFld(I,OB_Js(I,bi,bj)+2,1,bi,bj)
90     #else
91 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
92     vFld(I,OB_Js(I,bi,bj)+1,1,bi,bj)=
93     & min(OBSvice(I,bi,bj),vFld(I,OB_Js(I,bi,bj)+1,1,bi,bj))
94     & * _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
95     #else
96 dimitri 1.1 vFld(I,OB_Js(I,bi,bj)+1,1,bi,bj)=OBSvice(I,bi,bj)
97     & *_maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
98 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
99 dimitri 1.1 uFld(I,OB_Js(I,bi,bj),1,bi,bj)=OBSuice(I,bi,bj)
100     & *_maskW(I,OB_Js(I,bi,bj),K,bi,bj)
101 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
102 dimitri 1.7 if ( _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) .NE. 0. .AND.
103     & _maskS(I,OB_Js(I,bi,bj)+3,K,bi,bj) .NE. 0. )
104 dimitri 1.8 & vFld(I,OB_Js(I,bi,bj)+2,1,bi,bj) = 0.5 _d 0 *
105     & ( vFld(I,OB_Js(I,bi,bj)+1,1,bi,bj) +
106     & vFld(I,OB_Js(I,bi,bj)+3,1,bi,bj) ) *
107     & _maskS(I,OB_Js(I,bi,bj)+2,K,bi,bj)
108     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
109     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
110     if ( _maskW(I,OB_Js(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
111     & _maskW(I,OB_Js(I,bi,bj)+2,K,bi,bj) .NE. 0. )
112     & uFld(I,OB_Js(I,bi,bj)+1,1,bi,bj) = 0.5 _d 0 *
113     & ( uFld(I,OB_Js(I,bi,bj) ,1,bi,bj) +
114     & uFld(I,OB_Js(I,bi,bj)+2,1,bi,bj) ) *
115     & _maskW(I,OB_Js(I,bi,bj)+1,K,bi,bj)
116     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
117 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
118 dimitri 1.1 ENDIF
119     ENDDO
120 dimitri 1.5 endif
121 dimitri 1.7 #endif /* ALLOW_OBCS_SOUTH */
122 dimitri 1.1
123     C Set model variables to OB values on East/West Boundaries
124     #ifdef ALLOW_OBCS_EAST
125 dimitri 1.5 if ( OBEuicefile .NE. ' ' ) then
126 dimitri 1.1 DO J=1-Oly,sNy+Oly
127 dimitri 1.4 C Eastern boundary
128 dimitri 1.1 IF (OB_Ie(J,bi,bj).NE.0) THEN
129 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
130     uFld(OB_Ie(J,bi,bj),J,1,bi,bj) =
131     & _maskW(OB_Ie(J,bi,bj),J,K,bi,bj) *
132     & uFld(OB_Ie(J,bi,bj)-1,J,1,bi,bj)
133     #else
134 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
135     uFld(OB_Ie(J,bi,bj),J,1,bi,bj)=
136     & max(OBEuice(J,bi,bj),uFld(OB_Ie(J,bi,bj),J,1,bi,bj))
137     & * _maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
138     #else
139 dimitri 1.1 uFld(OB_Ie(J,bi,bj),J,1,bi,bj)=OBEuice(J,bi,bj)
140     & *_maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
141 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
142 dimitri 1.1 vFld(OB_Ie(J,bi,bj),J,1,bi,bj)=OBEvice(J,bi,bj)
143     & *_maskS(OB_Ie(J,bi,bj),J,K,bi,bj)
144 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
145 dimitri 1.7 if ( _maskW(OB_Ie(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
146     & _maskW(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
147 dimitri 1.8 & uFld(OB_Ie(J,bi,bj)-1,J,1,bi,bj) = 0.5 _d 0 *
148     & ( uFld(OB_Ie(J,bi,bj) ,J,1,bi,bj) +
149     & uFld(OB_Ie(J,bi,bj)-2,J,1,bi,bj) ) *
150     & _maskW(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
151     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
152     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
153     if ( _maskS(OB_Ie(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
154     & _maskS(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
155     & vFld(OB_Ie(J,bi,bj)-1,J,1,bi,bj) = 0.5 _d 0 *
156     & ( vFld(OB_Ie(J,bi,bj) ,J,1,bi,bj) +
157     & vFld(OB_Ie(J,bi,bj)-2,J,1,bi,bj) ) *
158     & _maskS(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
159     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
160 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
161 dimitri 1.1 ENDIF
162     ENDDO
163 dimitri 1.5 endif
164 dimitri 1.7 #endif /* ALLOW_OBCS_EAST */
165 dimitri 1.1 #ifdef ALLOW_OBCS_WEST
166 dimitri 1.5 if ( OBWuicefile .NE. ' ' ) then
167 dimitri 1.1 DO J=1-Oly,sNy+Oly
168 dimitri 1.4 C Western boundary
169 dimitri 1.1 IF (OB_Iw(J,bi,bj).NE.0) THEN
170 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
171     uFld(OB_Iw(J,bi,bj)+1,J,1,bi,bj)=
172     & _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) *
173     & uFld(OB_Ie(J,bi,bj)+2,J,1,bi,bj)
174     #else
175 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
176     uFld(OB_Iw(J,bi,bj)+1,J,1,bi,bj)=
177     & min(OBWuice(J,bi,bj),uFld(OB_Iw(J,bi,bj)+1,J,1,bi,bj))
178     & * _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
179     #else
180 dimitri 1.3 uFld(OB_Iw(J,bi,bj)+1,J,1,bi,bj)=OBWuice(J,bi,bj)
181 dimitri 1.1 & *_maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
182 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
183 dimitri 1.8 vFld(OB_Iw(J,bi,bj),J,1,bi,bj)=OBWvice(J,bi,bj)
184     & *_maskS(OB_Iw(J,bi,bj),J,K,bi,bj)
185     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
186 dimitri 1.7 if ( _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) .NE. 0. .AND.
187     & _maskW(OB_Iw(J,bi,bj)+3,J,K,bi,bj) .NE. 0. )
188 dimitri 1.8 & uFld(OB_Ie(J,bi,bj)+2,J,1,bi,bj) = 0.5 _d 0 *
189     & ( uFld(OB_Ie(J,bi,bj)+1,J,1,bi,bj) +
190     & uFld(OB_Ie(J,bi,bj)+3,J,1,bi,bj) ) *
191     & _maskW(OB_Ie(J,bi,bj)+2,J,K,bi,bj)
192     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
193     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
194     if ( _maskS(OB_Iw(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
195     & _maskS(OB_Iw(J,bi,bj)+2,J,K,bi,bj) .NE. 0. )
196     & vFld(OB_Ie(J,bi,bj)+1,J,1,bi,bj) = 0.5 _d 0 *
197     & ( vFld(OB_Ie(J,bi,bj) ,J,1,bi,bj) +
198     & vFld(OB_Ie(J,bi,bj)+2,J,1,bi,bj) ) *
199     & _maskS(OB_Ie(J,bi,bj)+1,J,K,bi,bj)
200     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
201 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
202 dimitri 1.1 ENDIF
203     ENDDO
204 dimitri 1.5 endif
205 dimitri 1.7 #endif /* ALLOW_OBCS_WEST */
206 dimitri 1.1
207 dimitri 1.2 ENDDO
208     ENDDO
209    
210 dimitri 1.1 #endif /* defined (ALLOW_OBCS) && defined (ALLOW_SEAICE) */
211    
212     RETURN
213     END
  ViewVC Help
Powered by ViewVC 1.1.22