/[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.13 - (hide annotations) (download)
Mon May 5 22:45:00 2008 UTC (16 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint65o, checkpoint59q, checkpoint59r, checkpoint62b, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61f, checkpoint61n, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.12: +47 -2 lines 
Add energy & enstrophy conserving scheme (selectVortScheme=3)
 (from Sadourny, described by Burridge & Haseler, ECMWF Rep.4, 1977)
1 jmc 1.13 C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis.F,v 1.12 2008/04/02 21:18:45 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     I uFld, omega3, hFacZ, r_hFacZ,
12     O vCoriolisTerm,
13     I myThid )
14     C !DESCRIPTION: \bv
15 jmc 1.4 C *==========================================================*
16     C | S/R MOM_VI_V_CORIOLIS
17 jmc 1.12 C |==========================================================*
18     C | o Calculate flux (in X-dir.) of vorticity at V point
19     C | using 2nd order interpolation
20 jmc 1.4 C *==========================================================*
21 jmc 1.12 C \ev
22    
23     C !USES:
24     IMPLICIT NONE
25 adcroft 1.2
26     C == Global variables ==
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29     #include "GRID.h"
30     #include "PARAMS.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     INTEGER myThid
41 jmc 1.12 CEOP
42 adcroft 1.2
43     C == Local variables ==
44 jmc 1.12 C msgBuf :: Informational/error meesage buffer
45     CHARACTER*(MAX_LEN_MBUF) msgBuf
46     LOGICAL upwindVort3
47     INTEGER i, j
48     _RL uBarXY, uBarYm, uBarYp
49     _RL vort3v
50 jmc 1.13 _RL vort3im, vort3ij, vort3pm, vort3pj
51     _RL oneThird, tmpFac
52 jmc 1.12 _RS epsil
53     PARAMETER( upwindVort3 = .FALSE. )
54 jmc 1.4
55     epsil = 1. _d -9
56 jmc 1.13 tmpFac = 1. _d 0
57     c oneThird = 1. _d 0 / ( 1. _d 0 + 2.*tmpFac )
58     oneThird = 1. _d 0 / 3. _d 0
59 jmc 1.4
60 jmc 1.12 IF ( selectVortScheme.EQ.0 ) THEN
61     C-- using enstrophy conserving scheme (Shallow-Water Eq.) by Sadourny, JAS 75
62    
63     DO j=2-Oly,sNy+Oly
64     DO i=1-Olx,sNx+Olx-1
65 adcroft 1.2 uBarXY=0.25*(
66 heimbach 1.10 & (uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
67     & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj))
68     & +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
69 jmc 1.12 & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj))
70     & )
71     IF (upwindVort3) THEN
72 adcroft 1.2 IF (uBarXY.GT.0.) THEN
73     vort3v=omega3(i,j)*r_hFacZ(i,j)
74     ELSE
75     vort3v=omega3(i+1,j)*r_hFacZ(i+1,j)
76     ENDIF
77     ELSE
78 jmc 1.4 vort3v=0.5*(omega3(i,j)*r_hFacZ(i,j)
79     & +omega3(i+1,j)*r_hFacZ(i+1,j))
80 adcroft 1.2 ENDIF
81 jmc 1.12 vCoriolisTerm(i,j)= -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
82     & * _maskS(i,j,k,bi,bj)
83     ENDDO
84     ENDDO
85    
86     ELSEIF ( selectVortScheme.EQ.1 ) THEN
87     C-- same as above, with different formulation (relatively to hFac)
88    
89     DO j=2-Oly,sNy+Oly
90     DO i=1-Olx,sNx+Olx-1
91     uBarXY= 0.5*(
92     & (uFld( i , j )*dyG( i , j ,bi,bj)*hFacZ( i ,j)
93     & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacZ( i ,j))
94 jmc 1.9 & +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacZ(i+1,j)
95     & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacZ(i+1,j))
96 jmc 1.12 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i+1,j) )
97     IF (upwindVort3) THEN
98 jmc 1.4 IF (uBarXY.GT.0.) THEN
99     vort3v=omega3(i,j)
100     ELSE
101     vort3v=omega3(i+1,j)
102     ENDIF
103     ELSE
104     vort3v=0.5*(omega3(i,j)+omega3(i+1,j))
105     ENDIF
106 jmc 1.12 vCoriolisTerm(i,j)= -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
107     & * _maskS(i,j,k,bi,bj)
108     ENDDO
109     ENDDO
110    
111     ELSEIF ( selectVortScheme.EQ.2 ) THEN
112     C-- using energy conserving scheme (used by Sadourny in JAS 75 paper)
113    
114     DO j=2-Oly,sNy+Oly
115     DO i=1-Olx,sNx+Olx-1
116     uBarYm=0.5*(
117     & uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
118     & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
119     uBarYp=0.5*(
120     & uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
121     & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
122     IF (upwindVort3) THEN
123     IF ( (uBarYm+uBarYp) .GT.0.) THEN
124     vort3v=uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
125     ELSE
126     vort3v=uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
127     ENDIF
128     ELSE
129     vort3v = ( uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
130     & +uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
131     & )*0.5 _d 0
132     ENDIF
133     vCoriolisTerm(i,j)= -vort3v*recip_dyC(i,j,bi,bj)
134     & * _maskS(i,j,k,bi,bj)
135     ENDDO
136     ENDDO
137 adcroft 1.5
138 jmc 1.13 ELSEIF ( selectVortScheme.EQ.3 ) THEN
139     C-- using energy & enstrophy conserving scheme
140     C (from Sadourny, described by Burridge & Haseler, ECMWF Rep.4, 1977)
141    
142     C domain where vCoriolisTerm is valid :
143     C [ 2-Olx : sNx+Olx-1 ] x [ 3-Oly : sNy+Oly-1 ]
144     C (=> might need overlap of 3 if using CD-scheme)
145     DO j=2-Oly,sNy+Oly-1
146     DO i=1-Olx,sNx+Olx-1
147     vort3im= ( r_hFacZ(i, j )*omega3(i, j )
148     & +(r_hFacZ(i+1,j)*omega3(i+1,j)
149     & +r_hFacZ(i,j-1)*omega3(i,j-1)
150     & ))*oneThird
151     c & )*tmpFac)*oneThird
152     & *uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj)
153     vort3ij= ( r_hFacZ(i, j )*omega3(i, j )
154     & +(r_hFacZ(i+1,j)*omega3(i+1,j)
155     & +r_hFacZ(i,j+1)*omega3(i,j+1)
156     & ))*oneThird
157     c & )*tmpFac)*oneThird
158     & *uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
159     vort3pm= ( r_hFacZ(i+1,j)*omega3(i+1,j)
160     & +(r_hFacZ(i, j )*omega3(i, j )
161     & +r_hFacZ(i+1,j-1)*omega3(i+1,j-1)
162     & ))*oneThird
163     c & )*tmpFac)*oneThird
164     & *uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj)
165     vort3pj= ( r_hFacZ(i+1,j)*omega3(i+1,j)
166     & +(r_hFacZ(i, j )*omega3(i, j )
167     & +r_hFacZ(i+1,j+1)*omega3(i+1,j+1)
168     & ))*oneThird
169     c & )*tmpFac)*oneThird
170     & *uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
171     C---
172     vCoriolisTerm(i,j)= -( (vort3im+vort3ij)+(vort3pm+vort3pj) )
173     & *0.25 _d 0 *recip_dyC(i,j,bi,bj)
174     & * _maskS(i,j,k,bi,bj)
175     ENDDO
176     ENDDO
177    
178 jmc 1.12 ELSE
179     WRITE(msgBuf,'(A,I5,A)')
180     & 'MOM_VI_V_CORIOLIS: selectVortScheme=', selectVortScheme,
181     & ' not implemented'
182     CALL PRINT_ERROR( msgBuf, myThid )
183     STOP 'ABNORMAL END: S/R MOM_VI_V_CORIOLIS'
184    
185     ENDIF
186    
187     IF ( useJamartMomAdv ) THEN
188 jmc 1.13 DO j=2-Oly,sNy+Oly-1
189 jmc 1.12 DO i=1-Olx,sNx+Olx-1
190     vCoriolisTerm(i,j) = vCoriolisTerm(i,j)
191     & * 4. _d 0 * _hFacS(i,j,k,bi,bj)
192     & / MAX( epsil,
193     & (_hFacW( i ,j,k,bi,bj)+_hFacW( i ,j-1,k,bi,bj))
194     & +(_hFacW(i+1,j,k,bi,bj)+_hFacW(i+1,j-1,k,bi,bj))
195     & )
196     ENDDO
197 adcroft 1.2 ENDDO
198 jmc 1.12 ENDIF
199 adcroft 1.2
200     RETURN
201     END
  ViewVC Help
Powered by ViewVC 1.1.22