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

Annotation of /MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis_c4.F

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

Revision 1.8 - (hide annotations) (download)
Mon Jun 12 21:15:27 2006 UTC (17 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, mitgcm_mapl_00, checkpoint58r_post, checkpoint58n_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58x_post, checkpoint59j, checkpoint58j_post, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.7: +83 -26 lines 
fix Corner Pb on CS-grid: no longer loosing mass.
1 jmc 1.8 C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_vi_v_coriolis_c4.F,v 1.7 2006/06/07 01:55:15 heimbach Exp $
2 adcroft 1.3 C $Name: $
3 adcroft 1.2
4 adcroft 1.3 #include "MOM_VECINV_OPTIONS.h"
5 adcroft 1.2
6 jmc 1.5 CBOP
7     C !ROUTINE: MOM_VI_V_CORIOLIS_C4
8     C !INTERFACE:
9     SUBROUTINE MOM_VI_V_CORIOLIS_C4(
10     I bi,bj,k,
11 adcroft 1.2 I uFld,omega3,r_hFacZ,
12     O vCoriolisTerm,
13     I myThid)
14 jmc 1.5 C !DESCRIPTION: \bv
15     C *==========================================================*
16     C | S/R MOM_VI_V_CORIOLIS_C4
17     C |==========================================================*
18     C | o Calculate zonal flux of vorticity at V point
19     C | using 4th order interpolation
20     C *==========================================================*
21     C \ev
22    
23     C !USES:
24 adcroft 1.2 IMPLICIT NONE
25    
26     C == Global variables ==
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29 jmc 1.8 #include "PARAMS.h"
30 adcroft 1.2 #include "GRID.h"
31 jmc 1.8 #ifdef ALLOW_EXCH2
32     #include "W2_EXCH2_TOPOLOGY.h"
33     #include "W2_EXCH2_PARAMS.h"
34     #endif /* ALLOW_EXCH2 */
35 adcroft 1.2
36 jmc 1.5 C !INPUT/OUTPUT PARAMETERS:
37 adcroft 1.2 C == Routine arguments ==
38 jmc 1.5 INTEGER bi,bj,k
39 adcroft 1.2 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40     _RL omega3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
41     _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42     _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43     INTEGER myThid
44 jmc 1.5 CEOP
45 adcroft 1.2
46     C == Local variables ==
47 jmc 1.5 INTEGER i,j
48 jmc 1.8 _RL vort3r(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49 adcroft 1.2 _RL uBarXY,vort3v,Rjp,Rjm
50 jmc 1.8 _RL uBarYm,uBarYp
51    
52     LOGICAL northWestCorner, northEastCorner,
53     & southWestCorner, southEastCorner
54     INTEGER myFace
55     #ifdef ALLOW_EXCH2
56     INTEGER myTile
57     #endif /* ALLOW_EXCH2 */
58     _RL oneSixth, oneTwelve
59 adcroft 1.2 LOGICAL upwindVort3
60     LOGICAL fourthVort3
61 jmc 1.8 PARAMETER(oneSixth=1.D0/6.D0 , oneTwelve=1.D0/12.D0)
62 jmc 1.5 PARAMETER(upwindVort3=.FALSE.)
63     PARAMETER(fourthVort3=.TRUE. )
64    
65 jmc 1.8 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66    
67     DO j=1-Oly,sNy+Oly
68     DO i=1-Olx,sNx+Olx
69     vort3r(i,j) = r_hFacZ(i,j)*omega3(i,j)
70     ENDDO
71     ENDDO
72    
73     C-- Special stuff for Cubed Sphere
74     IF (useCubedSphereExchange) THEN
75    
76     #ifdef ALLOW_EXCH2
77     myTile = W2_myTileList(bi)
78     myFace = exch2_myFace(myTile)
79     southWestCorner = exch2_isWedge(myTile).EQ.1
80     & .AND. exch2_isSedge(myTile).EQ.1
81     southEastCorner = exch2_isEedge(myTile).EQ.1
82     & .AND. exch2_isSedge(myTile).EQ.1
83     northEastCorner = exch2_isEedge(myTile).EQ.1
84     & .AND. exch2_isNedge(myTile).EQ.1
85     northWestCorner = exch2_isWedge(myTile).EQ.1
86     & .AND. exch2_isNedge(myTile).EQ.1
87     #else
88     myFace = bi
89     southWestCorner = .TRUE.
90     southEastCorner = .TRUE.
91     northWestCorner = .TRUE.
92     northEastCorner = .TRUE.
93     #endif /* ALLOW_EXCH2 */
94     IF ( southWestCorner ) THEN
95     i = 1
96     j = 1
97     vort3r(i-1,j) = ( vort3r(i-1,j) + vort3r(i,j+1) )*0.5 _d 0
98     ENDIF
99     IF ( southEastCorner ) THEN
100     i = sNx+1
101     j = 1
102     vort3r(i+1,j) = ( vort3r(i+1,j) + vort3r(i,j+1) )*0.5 _d 0
103     ENDIF
104     IF ( northWestCorner ) THEN
105     i = 1
106     j = sNy+1
107     vort3r(i-1,j) = ( vort3r(i-1,j) + vort3r(i,j-1) )*0.5 _d 0
108     ENDIF
109     IF ( northEastCorner ) THEN
110     i = sNx+1
111     j = sNy+1
112     vort3r(i+1,j) = ( vort3r(i+1,j) + vort3r(i,j-1) )*0.5 _d 0
113     ENDIF
114    
115     C-- End of special stuff for Cubed Sphere.
116     ENDIF
117    
118     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
119 jmc 1.5 c DO j=2-Oly,sNy+Oly
120     c DO i=2-Olx,sNx+Olx-2
121     DO j=1,sNy+1
122     DO i=1,sNx
123    
124     IF ( SadournyCoriolis ) THEN
125     C- using SadournyCoriolis discretization:
126    
127     uBarXY=1.
128     uBarYm=0.5*(
129 heimbach 1.7 & uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
130     & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
131 jmc 1.5 uBarYp=0.5*(
132 heimbach 1.7 & uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
133     & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
134 jmc 1.5 IF (upwindVorticity) THEN
135     IF ( (uBarYm+uBarYp) .GT.0.) THEN
136 jmc 1.8 vort3v=uBarYm*vort3r( i ,j)
137 jmc 1.5 ELSE
138 jmc 1.8 vort3v=uBarYp*vort3r(i+1,j)
139 jmc 1.5 ENDIF
140     ELSEIF (fourthVort3) THEN
141 jmc 1.8 Rjp = vort3r(i+1,j) -oneSixth*( vort3r(i+2,j)-vort3r( i ,j) )
142     Rjm = vort3r( i ,j) +oneSixth*( vort3r(i+1,j)-vort3r(i-1,j) )
143 jmc 1.5 vort3v=0.5*( uBarYm*Rjm + uBarYp*Rjp )
144     ELSE
145 jmc 1.8 vort3v=0.5*( uBarYm*vort3r( i ,j) + uBarYp*vort3r(i+1,j) )
146 jmc 1.5 ENDIF
147    
148     ELSE
149     C- not using SadournyCoriolis discretization:
150 adcroft 1.2
151     uBarXY=0.25*(
152 heimbach 1.7 & (uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
153     & +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj))
154     & +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
155     & +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj))
156 jmc 1.6 & )
157 adcroft 1.2 IF (upwindVort3) THEN
158     IF (uBarXY.GT.0.) THEN
159 jmc 1.8 vort3v=vort3r(i,j)
160 adcroft 1.2 ELSE
161 jmc 1.8 vort3v=vort3r(i+1,j)
162 adcroft 1.2 ENDIF
163     ELSEIF (fourthVort3) THEN
164 jmc 1.8 Rjp = vort3r(i+2,j) - vort3r(i+1,j)
165     Rjm = vort3r( i ,j) - vort3r(i-1,j)
166     vort3v=0.5*( vort3r(i,j) + vort3r(i+1,j)
167     & -oneTwelve*(Rjp-Rjm)
168 adcroft 1.2 & )
169     ELSE
170 jmc 1.8 vort3v=0.5*( vort3r(i,j) + vort3r(i+1,j) )
171 adcroft 1.2 ENDIF
172 heimbach 1.4
173 jmc 1.5 C- end if / else SadournyCoriolis
174     ENDIF
175    
176     vCoriolisTerm(i,j)=
177     & -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
178     & * _maskS(i,j,k,bi,bj)
179 heimbach 1.4
180 adcroft 1.2 ENDDO
181 jmc 1.5 ENDDO
182 adcroft 1.2
183     RETURN
184     END
  ViewVC Help
Powered by ViewVC 1.1.22