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

Annotation 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 - (hide 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 mlosch 1.14 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 jmc 1.4 C $Name: $
3 adcroft 1.2
4 adcroft 1.7 #include "MOM_VECINV_OPTIONS.h"
5 adcroft 1.2
6 jmc 1.12 CBOP
7     C !ROUTINE: MOM_VI_V_CORIOLIS
8     C !INTERFACE:
9 jmc 1.9 SUBROUTINE MOM_VI_V_CORIOLIS(
10 jmc 1.12 I bi, bj, k,
11 mlosch 1.14 I selectVortScheme, useJamartMomAdv,
12 jmc 1.12 I uFld, omega3, hFacZ, r_hFacZ,
13     O vCoriolisTerm,
14     I myThid )
15     C !DESCRIPTION: \bv
16 jmc 1.4 C *==========================================================*
17     C | S/R MOM_VI_V_CORIOLIS
18 jmc 1.12 C |==========================================================*
19     C | o Calculate flux (in X-dir.) of vorticity at V point
20     C | using 2nd order interpolation
21 jmc 1.4 C *==========================================================*
22 jmc 1.12 C \ev
23    
24     C !USES:
25     IMPLICIT NONE
26 adcroft 1.2
27     C == Global variables ==
28     #include "SIZE.h"
29     #include "EEPARAMS.h"
30     #include "GRID.h"
31    
32 jmc 1.12 C !INPUT/OUTPUT PARAMETERS:
33 adcroft 1.2 C == Routine arguments ==
34 jmc 1.12 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 adcroft 1.2 _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40 mlosch 1.14 INTEGER selectVortScheme
41     LOGICAL useJamartMomAdv
42 adcroft 1.2 INTEGER myThid
43 jmc 1.12 CEOP
44 adcroft 1.2
45     C == Local variables ==
46 jmc 1.12 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 jmc 1.13 _RL vort3im, vort3ij, vort3pm, vort3pj
53     _RL oneThird, tmpFac
54 jmc 1.12 _RS epsil
55     PARAMETER( upwindVort3 = .FALSE. )
56 jmc 1.4
57     epsil = 1. _d -9
58 jmc 1.13 tmpFac = 1. _d 0
59     c oneThird = 1. _d 0 / ( 1. _d 0 + 2.*tmpFac )
60     oneThird = 1. _d 0 / 3. _d 0
61 jmc 1.4
62 jmc 1.12 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 adcroft 1.2 uBarXY=0.25*(
68 heimbach 1.10 & (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 jmc 1.12 & +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 adcroft 1.2 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 jmc 1.4 vort3v=0.5*(omega3(i,j)*r_hFacZ(i,j)
81     & +omega3(i+1,j)*r_hFacZ(i+1,j))
82 adcroft 1.2 ENDIF
83 jmc 1.12 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 jmc 1.9 & +(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 jmc 1.12 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i+1,j) )
99     IF (upwindVort3) THEN
100 jmc 1.4 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 jmc 1.12 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 adcroft 1.5
140 jmc 1.13 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 jmc 1.12 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 jmc 1.13 DO j=2-Oly,sNy+Oly-1
191 jmc 1.12 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 adcroft 1.2 ENDDO
200 jmc 1.12 ENDIF
201 adcroft 1.2
202     RETURN
203     END
  ViewVC Help
Powered by ViewVC 1.1.22