/[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.13 - (hide annotations) (download)
Mon May 5 22:45:00 2008 UTC (16 years 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: +48 -3 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_u_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_U_CORIOLIS
8     C !INTERFACE:
9 jmc 1.9 SUBROUTINE MOM_VI_U_CORIOLIS(
10 jmc 1.12 I bi, bj, k,
11     I vFld, omega3, hFacZ, r_hFacZ,
12     O uCoriolisTerm,
13     I myThid )
14     C !DESCRIPTION: \bv
15 jmc 1.4 C *==========================================================*
16     C | S/R MOM_VI_U_CORIOLIS
17 jmc 1.12 C |==========================================================*
18     C | o Calculate flux (in Y-dir.) of vorticity at U 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 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     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 vBarXY, vBarXm, vBarXp
49     _RL vort3u
50 jmc 1.13 _RL vort3mj, vort3ij, vort3mp, vort3ip
51     _RL oneThird, tmpFac
52 jmc 1.12 _RS epsil
53     PARAMETER( upwindVort3 = .FALSE. )
54 jmc 1.4
55 jmc 1.9 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=1-Oly,sNy+Oly-1
64     DO i=2-Olx,sNx+Olx
65 adcroft 1.2 vBarXY=0.25*(
66 heimbach 1.10 & (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
67     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj))
68     & +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
69 jmc 1.12 & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj))
70     & )
71     IF (upwindVort3) THEN
72 adcroft 1.2 IF (vBarXY.GT.0.) THEN
73 jmc 1.12 vort3u=omega3(i,j)*r_hFacZ(i,j)
74 adcroft 1.2 ELSE
75 jmc 1.12 vort3u=omega3(i,j+1)*r_hFacZ(i,j+1)
76 adcroft 1.2 ENDIF
77     ELSE
78 jmc 1.4 vort3u=0.5*(omega3(i,j)*r_hFacZ(i,j)
79     & +omega3(i,j+1)*r_hFacZ(i,j+1))
80 adcroft 1.2 ENDIF
81 jmc 1.12 uCoriolisTerm(i,j)= +vort3u*vBarXY*recip_dxC(i,j,bi,bj)
82     & * _maskW(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 jmc 1.13 DO j=1-Oly,sNy+Oly-1
90 jmc 1.12 DO i=2-Olx,sNx+Olx
91     vBarXY= 0.5*(
92     & (vFld( i , j )*dxG( i , j ,bi,bj)*hFacZ(i, j )
93     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*hFacZ(i, j ))
94 jmc 1.9 & +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*hFacZ(i,j+1)
95     & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*hFacZ(i,j+1))
96 jmc 1.12 & )/MAX( epsil, hFacZ(i,j)+hFacZ(i,j+1) )
97     IF (upwindVort3) THEN
98 jmc 1.4 IF (vBarXY.GT.0.) THEN
99     vort3u=omega3(i,j)
100     ELSE
101     vort3u=omega3(i,j+1)
102     ENDIF
103     ELSE
104 jmc 1.9 vort3u=0.5*(omega3(i,j)+omega3(i,j+1))
105 jmc 1.4 ENDIF
106 jmc 1.12 uCoriolisTerm(i,j)= +vort3u*vBarXY*recip_dxC(i,j,bi,bj)
107     & * _maskW(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=1-Oly,sNy+Oly-1
115     DO i=2-Olx,sNx+Olx
116     vBarXm=0.5*(
117     & vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
118     & +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj) )
119     vBarXp=0.5*(
120     & vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
121     & +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj) )
122     IF (upwindVort3) THEN
123     IF ( (vBarXm+vBarXp) .GT.0.) THEN
124     vort3u=vBarXm*r_hFacZ(i, j )*omega3(i, j )
125     ELSE
126     vort3u=vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1)
127     ENDIF
128     ELSE
129     vort3u = ( vBarXm*r_hFacZ(i, j )*omega3(i, j )
130     & +vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1)
131     & )*0.5 _d 0
132     ENDIF
133     uCoriolisTerm(i,j)= +vort3u*recip_dxC(i,j,bi,bj)
134     & * _maskW(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 uCoriolisTerm is valid :
143     C [ 3-Olx : sNx+Olx-1 ] x [ 2-Oly : sNy+Oly-1 ]
144     C (=> might need overlap of 3 if using CD-scheme)
145     DO j=1-Oly,sNy+Oly-1
146     DO i=2-Olx,sNx+Olx-1
147     vort3mj= ( r_hFacZ(i, j )*omega3(i, j )
148     & +(r_hFacZ(i,j+1)*omega3(i,j+1)
149     & +r_hFacZ(i-1,j)*omega3(i-1,j)
150     & ))*oneThird
151     c & )*tmpFac)*oneThird
152     & *vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj)
153     vort3ij= ( r_hFacZ(i, j )*omega3(i, j )
154     & +(r_hFacZ(i,j+1)*omega3(i,j+1)
155     & +r_hFacZ(i+1,j)*omega3(i+1,j)
156     & ))*oneThird
157     c & )*tmpFac)*oneThird
158     & *vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
159     vort3mp= ( r_hFacZ(i,j+1)*omega3(i,j+1)
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     & *vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj)
165     vort3ip= ( r_hFacZ(i,j+1)*omega3(i,j+1)
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     & *vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
171     C---
172     uCoriolisTerm(i,j)= +( (vort3mj+vort3ij)+(vort3mp+vort3ip) )
173     & *0.25 _d 0 *recip_dxC(i,j,bi,bj)
174     & * _maskW(i,j,k,bi,bj)
175     ENDDO
176     ENDDO
177    
178 jmc 1.12 ELSE
179     WRITE(msgBuf,'(A,I5,A)')
180     & 'MOM_VI_U_CORIOLIS: selectVortScheme=', selectVortScheme,
181     & ' not implemented'
182     CALL PRINT_ERROR( msgBuf, myThid )
183     STOP 'ABNORMAL END: S/R MOM_VI_U_CORIOLIS'
184    
185     ENDIF
186    
187     IF ( useJamartMomAdv ) THEN
188     DO j=1-Oly,sNy+Oly-1
189 jmc 1.13 DO i=2-Olx,sNx+Olx-1
190 jmc 1.12 uCoriolisTerm(i,j) = uCoriolisTerm(i,j)
191     & * 4. _d 0 * _hFacW(i,j,k,bi,bj)
192     & / MAX( epsil,
193     & (_hFacS(i, j ,k,bi,bj)+_hFacS(i-1, j ,k,bi,bj))
194     & +(_hFacS(i,j+1,k,bi,bj)+_hFacS(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