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

Annotation of /MITgcm/pkg/mom_vecinv/mom_vi_u_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, 4 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.13: +5 -3 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_u_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_U_CORIOLIS
8     C !INTERFACE:
9 jmc 1.9 SUBROUTINE MOM_VI_U_CORIOLIS(
10 mlosch 1.14 I bi, bj, k,
11     I selectVortScheme, useJamartMomAdv,
12 jmc 1.12 I vFld, omega3, hFacZ, r_hFacZ,
13     O uCoriolisTerm,
14     I myThid )
15     C !DESCRIPTION: \bv
16 jmc 1.4 C *==========================================================*
17     C | S/R MOM_VI_U_CORIOLIS
18 jmc 1.12 C |==========================================================*
19     C | o Calculate flux (in Y-dir.) of vorticity at U 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 vFld (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 uCoriolisTerm(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 vBarXY, vBarXm, vBarXp
51     _RL vort3u
52 jmc 1.13 _RL vort3mj, vort3ij, vort3mp, vort3ip
53     _RL oneThird, tmpFac
54 jmc 1.12 _RS epsil
55     PARAMETER( upwindVort3 = .FALSE. )
56 jmc 1.4
57 jmc 1.9 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=1-Oly,sNy+Oly-1
66     DO i=2-Olx,sNx+Olx
67 adcroft 1.2 vBarXY=0.25*(
68 heimbach 1.10 & (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
69     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj))
70     & +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
71 jmc 1.12 & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj))
72     & )
73     IF (upwindVort3) THEN
74 adcroft 1.2 IF (vBarXY.GT.0.) THEN
75 jmc 1.12 vort3u=omega3(i,j)*r_hFacZ(i,j)
76 adcroft 1.2 ELSE
77 jmc 1.12 vort3u=omega3(i,j+1)*r_hFacZ(i,j+1)
78 adcroft 1.2 ENDIF
79     ELSE
80 jmc 1.4 vort3u=0.5*(omega3(i,j)*r_hFacZ(i,j)
81     & +omega3(i,j+1)*r_hFacZ(i,j+1))
82 adcroft 1.2 ENDIF
83 jmc 1.12 uCoriolisTerm(i,j)= +vort3u*vBarXY*recip_dxC(i,j,bi,bj)
84     & * _maskW(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 jmc 1.13 DO j=1-Oly,sNy+Oly-1
92 jmc 1.12 DO i=2-Olx,sNx+Olx
93     vBarXY= 0.5*(
94     & (vFld( i , j )*dxG( i , j ,bi,bj)*hFacZ(i, j )
95     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*hFacZ(i, j ))
96 jmc 1.9 & +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*hFacZ(i,j+1)
97     & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*hFacZ(i,j+1))
98 jmc 1.12 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i,j+1) )
99     IF (upwindVort3) THEN
100 jmc 1.4 IF (vBarXY.GT.0.) THEN
101     vort3u=omega3(i,j)
102     ELSE
103     vort3u=omega3(i,j+1)
104     ENDIF
105     ELSE
106 jmc 1.9 vort3u=0.5*(omega3(i,j)+omega3(i,j+1))
107 jmc 1.4 ENDIF
108 jmc 1.12 uCoriolisTerm(i,j)= +vort3u*vBarXY*recip_dxC(i,j,bi,bj)
109     & * _maskW(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=1-Oly,sNy+Oly-1
117     DO i=2-Olx,sNx+Olx
118     vBarXm=0.5*(
119     & vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
120     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj) )
121     vBarXp=0.5*(
122     & vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
123     & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj) )
124     IF (upwindVort3) THEN
125     IF ( (vBarXm+vBarXp) .GT.0.) THEN
126     vort3u=vBarXm*r_hFacZ(i, j )*omega3(i, j )
127     ELSE
128     vort3u=vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1)
129     ENDIF
130     ELSE
131     vort3u = ( vBarXm*r_hFacZ(i, j )*omega3(i, j )
132     & +vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1)
133     & )*0.5 _d 0
134     ENDIF
135     uCoriolisTerm(i,j)= +vort3u*recip_dxC(i,j,bi,bj)
136     & * _maskW(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 uCoriolisTerm is valid :
145     C [ 3-Olx : sNx+Olx-1 ] x [ 2-Oly : sNy+Oly-1 ]
146     C (=> might need overlap of 3 if using CD-scheme)
147     DO j=1-Oly,sNy+Oly-1
148     DO i=2-Olx,sNx+Olx-1
149     vort3mj= ( r_hFacZ(i, j )*omega3(i, j )
150     & +(r_hFacZ(i,j+1)*omega3(i,j+1)
151     & +r_hFacZ(i-1,j)*omega3(i-1,j)
152     & ))*oneThird
153     c & )*tmpFac)*oneThird
154     & *vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj)
155     vort3ij= ( r_hFacZ(i, j )*omega3(i, j )
156     & +(r_hFacZ(i,j+1)*omega3(i,j+1)
157     & +r_hFacZ(i+1,j)*omega3(i+1,j)
158     & ))*oneThird
159     c & )*tmpFac)*oneThird
160     & *vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
161     vort3mp= ( r_hFacZ(i,j+1)*omega3(i,j+1)
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     & *vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj)
167     vort3ip= ( r_hFacZ(i,j+1)*omega3(i,j+1)
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     & *vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
173     C---
174     uCoriolisTerm(i,j)= +( (vort3mj+vort3ij)+(vort3mp+vort3ip) )
175     & *0.25 _d 0 *recip_dxC(i,j,bi,bj)
176     & * _maskW(i,j,k,bi,bj)
177     ENDDO
178     ENDDO
179    
180 jmc 1.12 ELSE
181     WRITE(msgBuf,'(A,I5,A)')
182     & 'MOM_VI_U_CORIOLIS: selectVortScheme=', selectVortScheme,
183     & ' not implemented'
184     CALL PRINT_ERROR( msgBuf, myThid )
185     STOP 'ABNORMAL END: S/R MOM_VI_U_CORIOLIS'
186    
187     ENDIF
188    
189     IF ( useJamartMomAdv ) THEN
190     DO j=1-Oly,sNy+Oly-1
191 jmc 1.13 DO i=2-Olx,sNx+Olx-1
192 jmc 1.12 uCoriolisTerm(i,j) = uCoriolisTerm(i,j)
193     & * 4. _d 0 * _hFacW(i,j,k,bi,bj)
194     & / MAX( epsil,
195     & (_hFacS(i, j ,k,bi,bj)+_hFacS(i-1, j ,k,bi,bj))
196     & +(_hFacS(i,j+1,k,bi,bj)+_hFacS(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