/[MITgcm]/MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis.F
ViewVC logotype

Contents of /MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis.F

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


Revision 1.14 - (show annotations) (download)
Fri Apr 28 17:17:14 2017 UTC (7 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.13: +4 -2 lines
 pass these runtime flags as formal parameters to
  s/r mom_vi_u/v_coriolis, mom_vi_u/v_coriolis_c4, so that these routines
  can also be used in pkg/seaice:
  selectVortScheme, highOrderVorticity, upwindVorticity, useJamartMomAdv

1 C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis.F,v 1.13 2008/05/05 22:45:00 jmc Exp $
2 C $Name: $
3
4 #include "MOM_VECINV_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: MOM_VI_V_CORIOLIS
8 C !INTERFACE:
9 SUBROUTINE MOM_VI_V_CORIOLIS(
10 I bi, bj, k,
11 I selectVortScheme, useJamartMomAdv,
12 I uFld, omega3, hFacZ, r_hFacZ,
13 O vCoriolisTerm,
14 I myThid )
15 C !DESCRIPTION: \bv
16 C *==========================================================*
17 C | S/R MOM_VI_V_CORIOLIS
18 C |==========================================================*
19 C | o Calculate flux (in X-dir.) of vorticity at V point
20 C | using 2nd order interpolation
21 C *==========================================================*
22 C \ev
23
24 C !USES:
25 IMPLICIT NONE
26
27 C == Global variables ==
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30 #include "GRID.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C == Routine arguments ==
34 INTEGER bi, bj, k
35 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
36 _RL omega3 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37 _RS hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38 _RS r_hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
39 _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40 INTEGER selectVortScheme
41 LOGICAL useJamartMomAdv
42 INTEGER myThid
43 CEOP
44
45 C == Local variables ==
46 C msgBuf :: Informational/error meesage buffer
47 CHARACTER*(MAX_LEN_MBUF) msgBuf
48 LOGICAL upwindVort3
49 INTEGER i, j
50 _RL uBarXY, uBarYm, uBarYp
51 _RL vort3v
52 _RL vort3im, vort3ij, vort3pm, vort3pj
53 _RL oneThird, tmpFac
54 _RS epsil
55 PARAMETER( upwindVort3 = .FALSE. )
56
57 epsil = 1. _d -9
58 tmpFac = 1. _d 0
59 c oneThird = 1. _d 0 / ( 1. _d 0 + 2.*tmpFac )
60 oneThird = 1. _d 0 / 3. _d 0
61
62 IF ( selectVortScheme.EQ.0 ) THEN
63 C-- using enstrophy conserving scheme (Shallow-Water Eq.) by Sadourny, JAS 75
64
65 DO j=2-Oly,sNy+Oly
66 DO i=1-Olx,sNx+Olx-1
67 uBarXY=0.25*(
68 & (uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
69 & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj))
70 & +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
71 & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj))
72 & )
73 IF (upwindVort3) THEN
74 IF (uBarXY.GT.0.) THEN
75 vort3v=omega3(i,j)*r_hFacZ(i,j)
76 ELSE
77 vort3v=omega3(i+1,j)*r_hFacZ(i+1,j)
78 ENDIF
79 ELSE
80 vort3v=0.5*(omega3(i,j)*r_hFacZ(i,j)
81 & +omega3(i+1,j)*r_hFacZ(i+1,j))
82 ENDIF
83 vCoriolisTerm(i,j)= -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
84 & * _maskS(i,j,k,bi,bj)
85 ENDDO
86 ENDDO
87
88 ELSEIF ( selectVortScheme.EQ.1 ) THEN
89 C-- same as above, with different formulation (relatively to hFac)
90
91 DO j=2-Oly,sNy+Oly
92 DO i=1-Olx,sNx+Olx-1
93 uBarXY= 0.5*(
94 & (uFld( i , j )*dyG( i , j ,bi,bj)*hFacZ( i ,j)
95 & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacZ( i ,j))
96 & +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacZ(i+1,j)
97 & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacZ(i+1,j))
98 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i+1,j) )
99 IF (upwindVort3) THEN
100 IF (uBarXY.GT.0.) THEN
101 vort3v=omega3(i,j)
102 ELSE
103 vort3v=omega3(i+1,j)
104 ENDIF
105 ELSE
106 vort3v=0.5*(omega3(i,j)+omega3(i+1,j))
107 ENDIF
108 vCoriolisTerm(i,j)= -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
109 & * _maskS(i,j,k,bi,bj)
110 ENDDO
111 ENDDO
112
113 ELSEIF ( selectVortScheme.EQ.2 ) THEN
114 C-- using energy conserving scheme (used by Sadourny in JAS 75 paper)
115
116 DO j=2-Oly,sNy+Oly
117 DO i=1-Olx,sNx+Olx-1
118 uBarYm=0.5*(
119 & uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
120 & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
121 uBarYp=0.5*(
122 & uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
123 & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
124 IF (upwindVort3) THEN
125 IF ( (uBarYm+uBarYp) .GT.0.) THEN
126 vort3v=uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
127 ELSE
128 vort3v=uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
129 ENDIF
130 ELSE
131 vort3v = ( uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
132 & +uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
133 & )*0.5 _d 0
134 ENDIF
135 vCoriolisTerm(i,j)= -vort3v*recip_dyC(i,j,bi,bj)
136 & * _maskS(i,j,k,bi,bj)
137 ENDDO
138 ENDDO
139
140 ELSEIF ( selectVortScheme.EQ.3 ) THEN
141 C-- using energy & enstrophy conserving scheme
142 C (from Sadourny, described by Burridge & Haseler, ECMWF Rep.4, 1977)
143
144 C domain where vCoriolisTerm is valid :
145 C [ 2-Olx : sNx+Olx-1 ] x [ 3-Oly : sNy+Oly-1 ]
146 C (=> might need overlap of 3 if using CD-scheme)
147 DO j=2-Oly,sNy+Oly-1
148 DO i=1-Olx,sNx+Olx-1
149 vort3im= ( r_hFacZ(i, j )*omega3(i, j )
150 & +(r_hFacZ(i+1,j)*omega3(i+1,j)
151 & +r_hFacZ(i,j-1)*omega3(i,j-1)
152 & ))*oneThird
153 c & )*tmpFac)*oneThird
154 & *uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj)
155 vort3ij= ( r_hFacZ(i, j )*omega3(i, j )
156 & +(r_hFacZ(i+1,j)*omega3(i+1,j)
157 & +r_hFacZ(i,j+1)*omega3(i,j+1)
158 & ))*oneThird
159 c & )*tmpFac)*oneThird
160 & *uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
161 vort3pm= ( r_hFacZ(i+1,j)*omega3(i+1,j)
162 & +(r_hFacZ(i, j )*omega3(i, j )
163 & +r_hFacZ(i+1,j-1)*omega3(i+1,j-1)
164 & ))*oneThird
165 c & )*tmpFac)*oneThird
166 & *uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj)
167 vort3pj= ( r_hFacZ(i+1,j)*omega3(i+1,j)
168 & +(r_hFacZ(i, j )*omega3(i, j )
169 & +r_hFacZ(i+1,j+1)*omega3(i+1,j+1)
170 & ))*oneThird
171 c & )*tmpFac)*oneThird
172 & *uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
173 C---
174 vCoriolisTerm(i,j)= -( (vort3im+vort3ij)+(vort3pm+vort3pj) )
175 & *0.25 _d 0 *recip_dyC(i,j,bi,bj)
176 & * _maskS(i,j,k,bi,bj)
177 ENDDO
178 ENDDO
179
180 ELSE
181 WRITE(msgBuf,'(A,I5,A)')
182 & 'MOM_VI_V_CORIOLIS: selectVortScheme=', selectVortScheme,
183 & ' not implemented'
184 CALL PRINT_ERROR( msgBuf, myThid )
185 STOP 'ABNORMAL END: S/R MOM_VI_V_CORIOLIS'
186
187 ENDIF
188
189 IF ( useJamartMomAdv ) THEN
190 DO j=2-Oly,sNy+Oly-1
191 DO i=1-Olx,sNx+Olx-1
192 vCoriolisTerm(i,j) = vCoriolisTerm(i,j)
193 & * 4. _d 0 * _hFacS(i,j,k,bi,bj)
194 & / MAX( epsil,
195 & (_hFacW( i ,j,k,bi,bj)+_hFacW( i ,j-1,k,bi,bj))
196 & +(_hFacW(i+1,j,k,bi,bj)+_hFacW(i+1,j-1,k,bi,bj))
197 & )
198 ENDDO
199 ENDDO
200 ENDIF
201
202 RETURN
203 END

  ViewVC Help
Powered by ViewVC 1.1.22