/[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.10 - (hide annotations) (download)
Wed Jun 24 08:04:07 2009 UTC (14 years, 11 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 mlosch 1.10 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uvice.F,v 1.9 2008/01/23 06:55:34 dimitri Exp $
2 dimitri 1.1 C $Name: $
3    
4     #include "OBCS_OPTIONS.h"
5    
6 dimitri 1.2 SUBROUTINE OBCS_APPLY_UVICE(
7 dimitri 1.4 U uFld, vFld,
8 dimitri 1.1 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 mlosch 1.10 _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 dimitri 1.1 INTEGER myThid
24    
25     #if (defined (ALLOW_OBCS) && defined (ALLOW_SEAICE))
26    
27     C == Local variables ==
28 dimitri 1.2 C I,J,K,bi,bj - Loop counters
29     INTEGER I,J,K,bi,bj
30     K = 1
31 dimitri 1.1
32 dimitri 1.2 DO bj=myByLo(myThid),myByHi(myThid)
33     DO bi=myBxLo(myThid),myBxHi(myThid)
34 dimitri 1.1
35     C Set model variables to OB values on North/South Boundaries
36     #ifdef ALLOW_OBCS_NORTH
37 dimitri 1.5 if ( OBNvicefile .NE. ' ' ) then
38 dimitri 1.1 DO I=1-Olx,sNx+Olx
39 dimitri 1.4 C Northern boundary
40 dimitri 1.1 IF (OB_Jn(I,bi,bj).NE.0) THEN
41 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
42 mlosch 1.10 vFld(I,OB_Jn(I,bi,bj) ,bi,bj) =
43 dimitri 1.7 & _maskS(I,OB_Jn(I,bi,bj),K,bi,bj) *
44 mlosch 1.10 & vFld(I,OB_Jn(I,bi,bj)-1,bi,bj)
45 dimitri 1.7 #else
46 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
47 mlosch 1.10 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 dimitri 1.4 & * _maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
50     #else
51 mlosch 1.10 vFld(I,OB_Jn(I,bi,bj),bi,bj)=OBNvice(I,bi,bj)
52 dimitri 1.1 & *_maskS(I,OB_Jn(I,bi,bj),K,bi,bj)
53 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
54 mlosch 1.10 uFld(I,OB_Jn(I,bi,bj),bi,bj)=OBNuice(I,bi,bj)
55 dimitri 1.1 & *_maskW(I,OB_Jn(I,bi,bj),K,bi,bj)
56 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
57 dimitri 1.7 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 mlosch 1.10 & 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 dimitri 1.8 & _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 mlosch 1.10 & 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 dimitri 1.8 & _maskW(I,OB_Jn(I,bi,bj)-1,K,bi,bj)
71     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
72 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
73 dimitri 1.1 ENDIF
74     ENDDO
75 dimitri 1.5 endif
76 dimitri 1.7 #endif /* ALLOW_OBCS_NORTH */
77 dimitri 1.1 #ifdef ALLOW_OBCS_SOUTH
78 dimitri 1.5 if ( OBSvicefile .NE. ' ' ) then
79 dimitri 1.1 DO I=1-Olx,sNx+Olx
80 dimitri 1.4 C Southern boundary
81 dimitri 1.1 IF (OB_Js(I,bi,bj).NE.0) THEN
82 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
83 mlosch 1.10 vFld(I,OB_Js(I,bi,bj)+1,bi,bj) =
84 dimitri 1.7 & _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj) *
85 mlosch 1.10 & vFld(I,OB_Js(I,bi,bj)+2,bi,bj)
86 dimitri 1.7 #else
87 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
88 mlosch 1.10 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 dimitri 1.4 & * _maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
91     #else
92 mlosch 1.10 vFld(I,OB_Js(I,bi,bj)+1,bi,bj)=OBSvice(I,bi,bj)
93 dimitri 1.1 & *_maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)
94 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
95 mlosch 1.10 uFld(I,OB_Js(I,bi,bj),bi,bj)=OBSuice(I,bi,bj)
96 dimitri 1.1 & *_maskW(I,OB_Js(I,bi,bj),K,bi,bj)
97 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
98 dimitri 1.7 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 mlosch 1.10 & 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 dimitri 1.8 & _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 mlosch 1.10 & 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 dimitri 1.8 & _maskW(I,OB_Js(I,bi,bj)+1,K,bi,bj)
112     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
113 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
114 dimitri 1.1 ENDIF
115     ENDDO
116 dimitri 1.5 endif
117 dimitri 1.7 #endif /* ALLOW_OBCS_SOUTH */
118 dimitri 1.1
119     C Set model variables to OB values on East/West Boundaries
120     #ifdef ALLOW_OBCS_EAST
121 dimitri 1.5 if ( OBEuicefile .NE. ' ' ) then
122 dimitri 1.1 DO J=1-Oly,sNy+Oly
123 dimitri 1.4 C Eastern boundary
124 dimitri 1.1 IF (OB_Ie(J,bi,bj).NE.0) THEN
125 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
126 mlosch 1.10 uFld(OB_Ie(J,bi,bj),J,bi,bj) =
127 dimitri 1.7 & _maskW(OB_Ie(J,bi,bj),J,K,bi,bj) *
128 mlosch 1.10 & uFld(OB_Ie(J,bi,bj)-1,J,bi,bj)
129 dimitri 1.7 #else
130 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
131 mlosch 1.10 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 dimitri 1.4 & * _maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
134     #else
135 mlosch 1.10 uFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEuice(J,bi,bj)
136 dimitri 1.1 & *_maskW(OB_Ie(J,bi,bj),J,K,bi,bj)
137 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
138 mlosch 1.10 vFld(OB_Ie(J,bi,bj),J,bi,bj)=OBEvice(J,bi,bj)
139 dimitri 1.1 & *_maskS(OB_Ie(J,bi,bj),J,K,bi,bj)
140 dimitri 1.8 #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
141 dimitri 1.7 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 mlosch 1.10 & 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 dimitri 1.8 & _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 mlosch 1.10 & 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 dimitri 1.8 & _maskS(OB_Ie(J,bi,bj)-1,J,K,bi,bj)
155     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
156 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
157 dimitri 1.1 ENDIF
158     ENDDO
159 dimitri 1.5 endif
160 dimitri 1.7 #endif /* ALLOW_OBCS_EAST */
161 dimitri 1.1 #ifdef ALLOW_OBCS_WEST
162 dimitri 1.5 if ( OBWuicefile .NE. ' ' ) then
163 dimitri 1.1 DO J=1-Oly,sNy+Oly
164 dimitri 1.4 C Western boundary
165 dimitri 1.1 IF (OB_Iw(J,bi,bj).NE.0) THEN
166 dimitri 1.7 #ifdef OBCS_SEAICE_COMPUTE_UVICE
167 mlosch 1.10 uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=
168 dimitri 1.7 & _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj) *
169 mlosch 1.10 & uFld(OB_Ie(J,bi,bj)+2,J,bi,bj)
170 dimitri 1.7 #else
171 dimitri 1.4 #ifdef OBCS_SEAICE_AVOID_CONVERGENCE
172 mlosch 1.10 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 dimitri 1.4 & * _maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
175     #else
176 mlosch 1.10 uFld(OB_Iw(J,bi,bj)+1,J,bi,bj)=OBWuice(J,bi,bj)
177 dimitri 1.1 & *_maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)
178 dimitri 1.7 #endif /* OBCS_SEAICE_AVOID_CONVERGENCE */
179 mlosch 1.10 vFld(OB_Iw(J,bi,bj),J,bi,bj)=OBWvice(J,bi,bj)
180 dimitri 1.8 & *_maskS(OB_Iw(J,bi,bj),J,K,bi,bj)
181     #ifdef OBCS_SEAICE_SMOOTH_UVICE_PERP
182 dimitri 1.7 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 mlosch 1.10 & 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 dimitri 1.8 & _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 mlosch 1.10 & 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 dimitri 1.8 & _maskS(OB_Ie(J,bi,bj)+1,J,K,bi,bj)
196     #endif /* OBCS_SEAICE_SMOOTH_UVICE_PAR */
197 dimitri 1.7 #endif /* OBCS_SEAICE_COMPUTE_UVICE */
198 dimitri 1.1 ENDIF
199     ENDDO
200 dimitri 1.5 endif
201 dimitri 1.7 #endif /* ALLOW_OBCS_WEST */
202 dimitri 1.1
203 dimitri 1.2 ENDDO
204     ENDDO
205    
206 dimitri 1.1 #endif /* defined (ALLOW_OBCS) && defined (ALLOW_SEAICE) */
207    
208     RETURN
209     END
  ViewVC Help
Powered by ViewVC 1.1.22