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

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

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

Revision 1.10 - (show annotations) (download)
Wed Jun 24 08:04:07 2009 UTC (14 years, 10 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62m, checkpoint62l, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.9: +51 -51 lines 
 third and step of replacing 3D versions of UICE,VICE,HEFF,AREA by 2D
 versions.
 I did my best here, but there are so many code options that are never
 tested in the verification experiments that I can only ask for
 forgiveness in advance
1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uvice.F,v 1.9 2008/01/23 06:55:34 dimitri Exp $
2 C $Name: $
3
4 #include "OBCS_OPTIONS.h"
5
6 SUBROUTINE OBCS_APPLY_UVICE(
7 U uFld, vFld,
8 I myThid )
9 C /==========================================================\
10 C | S/R OBCS_APPLY_UVICE |
11 C \==========================================================/
12 IMPLICIT NONE
13 C == Global variables ==
14 #include "SIZE.h"
15 #include "EEPARAMS.h"
16 #include "PARAMS.h"
17 #include "GRID.h"
18 #include "OBCS.h"
19
20 C == Routine Arguments ==
21 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
22 _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
23 INTEGER myThid
24
25 #if (defined (ALLOW_OBCS) && defined (ALLOW_SEAICE))
26
27 C == Local variables ==
28 C I,J,K,bi,bj - Loop counters
29 INTEGER I,J,K,bi,bj
30 K = 1
31
32 DO bj=myByLo(myThid),myByHi(myThid)
33 DO bi=myBxLo(myThid),myBxHi(myThid)
34
35 C Set model variables to OB values on North/South Boundaries
36 #ifdef ALLOW_OBCS_NORTH
37 if ( OBNvicefile .NE. ' ' ) then
38 DO I=1-Olx,sNx+Olx
39 C Northern boundary
40 IF (OB_Jn(I,bi,bj).NE.0) THEN
41 #ifdef OBCS_SEAICE_COMPUTE_UVICE
42 vFld(I,OB_Jn(I,bi,bj) ,bi,bj) =
43 & _maskS(I,OB_Jn(I,bi,bj),K,bi,bj) *
44 & vFld(I,OB_Jn(I,bi,bj)-1,bi,bj)
45 #else
46 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
47 vFld(I,OB_Jn(I,bi,bj),bi,bj)=
48 & max(OBNvice(I,bi,bj),vFld(I,OB_Jn(I,bi,bj),bi,bj))
49 & * _maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
50 #else
51 vFld(I,OB_Jn(I,bi,bj),bi,bj)=OBNvice(I,bi,bj)
52 & *_maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
53 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
54 uFld(I,OB_Jn(I,bi,bj),bi,bj)=OBNuice(I,bi,bj)
55 & *_maskW(I,OB_Jn(I,bi,bj),K,bi,bj)
56 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
57 if ( _maskS(I,OB_Jn(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
58 & _maskS(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
59 & vFld(I,OB_Jn(I,bi,bj)-1,bi,bj) = 0.5 _d 0 *
60 & ( vFld(I,OB_Jn(I,bi,bj) ,bi,bj) +
61 & vFld(I,OB_Jn(I,bi,bj)-2,bi,bj) ) *
62 & _maskS(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
63 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
64 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
65 if ( _maskW(I,OB_Jn(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
66 & _maskW(I,OB_Jn(I,bi,bj)-2,K,bi,bj) .NE. 0. )
67 & uFld(I,OB_Jn(I,bi,bj)-1,bi,bj) = 0.5 _d 0 *
68 & ( uFld(I,OB_Jn(I,bi,bj) ,bi,bj) +
69 & uFld(I,OB_Jn(I,bi,bj)-2,bi,bj) ) *
70 & _maskW(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
71 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
72 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
73 ENDIF
74 ENDDO
75 endif
76 #endif /* ALLOW_OBCS_NORTH */
77 #ifdef ALLOW_OBCS_SOUTH
78 if ( OBSvicefile .NE. ' ' ) then
79 DO I=1-Olx,sNx+Olx
80 C Southern boundary
81 IF (OB_Js(I,bi,bj).NE.0) THEN
82 #ifdef OBCS_SEAICE_COMPUTE_UVICE
83 vFld(I,OB_Js(I,bi,bj)+1,bi,bj) =
84 & _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) *
85 & vFld(I,OB_Js(I,bi,bj)+2,bi,bj)
86 #else
87 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
88 vFld(I,OB_Js(I,bi,bj)+1,bi,bj)=
89 & min(OBSvice(I,bi,bj),vFld(I,OB_Js(I,bi,bj)+1,bi,bj))
90 & * _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
91 #else
92 vFld(I,OB_Js(I,bi,bj)+1,bi,bj)=OBSvice(I,bi,bj)
93 & *_maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
94 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
95 uFld(I,OB_Js(I,bi,bj),bi,bj)=OBSuice(I,bi,bj)
96 & *_maskW(I,OB_Js(I,bi,bj),K,bi,bj)
97 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
98 if ( _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) .NE. 0. .AND.
99 & _maskS(I,OB_Js(I,bi,bj)+3,K,bi,bj) .NE. 0. )
100 & vFld(I,OB_Js(I,bi,bj)+2,bi,bj) = 0.5 _d 0 *
101 & ( vFld(I,OB_Js(I,bi,bj)+1,bi,bj) +
102 & vFld(I,OB_Js(I,bi,bj)+3,bi,bj) ) *
103 & _maskS(I,OB_Js(I,bi,bj)+2,K,bi,bj)
104 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
105 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
106 if ( _maskW(I,OB_Js(I,bi,bj) ,K,bi,bj) .NE. 0. .AND.
107 & _maskW(I,OB_Js(I,bi,bj)+2,K,bi,bj) .NE. 0. )
108 & uFld(I,OB_Js(I,bi,bj)+1,bi,bj) = 0.5 _d 0 *
109 & ( uFld(I,OB_Js(I,bi,bj) ,bi,bj) +
110 & uFld(I,OB_Js(I,bi,bj)+2,bi,bj) ) *
111 & _maskW(I,OB_Js(I,bi,bj)+1,K,bi,bj)
112 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
113 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
114 ENDIF
115 ENDDO
116 endif
117 #endif /* ALLOW_OBCS_SOUTH */
118
119 C Set model variables to OB values on East/West Boundaries
120 #ifdef ALLOW_OBCS_EAST
121 if ( OBEuicefile .NE. ' ' ) then
122 DO J=1-Oly,sNy+Oly
123 C Eastern boundary
124 IF (OB_Ie(J,bi,bj).NE.0) THEN
125 #ifdef OBCS_SEAICE_COMPUTE_UVICE
126 uFld(OB_Ie(J,bi,bj),J,bi,bj) =
127 & _maskW(OB_Ie(J,bi,bj),J,K,bi,bj) *
128 & uFld(OB_Ie(J,bi,bj)-1,J,bi,bj)
129 #else
130 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
131 uFld(OB_Ie(J,bi,bj),J,bi,bj)=
132 & max(OBEuice(J,bi,bj),uFld(OB_Ie(J,bi,bj),J,bi,bj))
133 & * _maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
134 #else
135 uFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEuice(J,bi,bj)
136 & *_maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
137 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
138 vFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEvice(J,bi,bj)
139 & *_maskS(OB_Ie(J,bi,bj),J,K,bi,bj)
140 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
141 if ( _maskW(OB_Ie(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
142 & _maskW(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
143 & uFld(OB_Ie(J,bi,bj)-1,J,bi,bj) = 0.5 _d 0 *
144 & ( uFld(OB_Ie(J,bi,bj) ,J,bi,bj) +
145 & uFld(OB_Ie(J,bi,bj)-2,J,bi,bj) ) *
146 & _maskW(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
147 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
148 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
149 if ( _maskS(OB_Ie(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
150 & _maskS(OB_Ie(J,bi,bj)-2,J,K,bi,bj) .NE. 0. )
151 & vFld(OB_Ie(J,bi,bj)-1,J,bi,bj) = 0.5 _d 0 *
152 & ( vFld(OB_Ie(J,bi,bj) ,J,bi,bj) +
153 & vFld(OB_Ie(J,bi,bj)-2,J,bi,bj) ) *
154 & _maskS(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
155 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
156 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
157 ENDIF
158 ENDDO
159 endif
160 #endif /* ALLOW_OBCS_EAST */
161 #ifdef ALLOW_OBCS_WEST
162 if ( OBWuicefile .NE. ' ' ) then
163 DO J=1-Oly,sNy+Oly
164 C Western boundary
165 IF (OB_Iw(J,bi,bj).NE.0) THEN
166 #ifdef OBCS_SEAICE_COMPUTE_UVICE
167 uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
168 & _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) *
169 & uFld(OB_Ie(J,bi,bj)+2,J,bi,bj)
170 #else
171 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
172 uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
173 & min(OBWuice(J,bi,bj),uFld(OB_Iw(J,bi,bj)+1,J,bi,bj))
174 & * _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
175 #else
176 uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=OBWuice(J,bi,bj)
177 & *_maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
178 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
179 vFld(OB_Iw(J,bi,bj),J,bi,bj)=OBWvice(J,bi,bj)
180 & *_maskS(OB_Iw(J,bi,bj),J,K,bi,bj)
181 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
182 if ( _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) .NE. 0. .AND.
183 & _maskW(OB_Iw(J,bi,bj)+3,J,K,bi,bj) .NE. 0. )
184 & uFld(OB_Ie(J,bi,bj)+2,J,bi,bj) = 0.5 _d 0 *
185 & ( uFld(OB_Ie(J,bi,bj)+1,J,bi,bj) +
186 & uFld(OB_Ie(J,bi,bj)+3,J,bi,bj) ) *
187 & _maskW(OB_Ie(J,bi,bj)+2,J,K,bi,bj)
188 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PERP */
189 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PAR
190 if ( _maskS(OB_Iw(J,bi,bj) ,J,K,bi,bj) .NE. 0. .AND.
191 & _maskS(OB_Iw(J,bi,bj)+2,J,K,bi,bj) .NE. 0. )
192 & vFld(OB_Ie(J,bi,bj)+1,J,bi,bj) = 0.5 _d 0 *
193 & ( vFld(OB_Ie(J,bi,bj) ,J,bi,bj) +
194 & vFld(OB_Ie(J,bi,bj)+2,J,bi,bj) ) *
195 & _maskS(OB_Ie(J,bi,bj)+1,J,K,bi,bj)
196 #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
197 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
198 ENDIF
199 ENDDO
200 endif
201 #endif /* ALLOW_OBCS_WEST */
202
203 ENDDO
204 ENDDO
205
206 #endif /* defined (ALLOW_OBCS) && defined (ALLOW_SEAICE) */
207
208 RETURN
209 END
  ViewVC Help
Powered by ViewVC 1.1.22