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

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

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

revision 1.4 by heimbach, Fri Dec 10 20:15:10 2004 UTC revision 1.5 by jmc, Mon Jun 20 23:23:00 2005 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "MOM_VECINV_OPTIONS.h"  #include "MOM_VECINV_OPTIONS.h"
5    
6        SUBROUTINE MOM_VI_V_CORIOLIS_C4(  CBOP
7       I        bi,bj,K,  C     !ROUTINE: MOM_VI_V_CORIOLIS_C4
8    C     !INTERFACE:
9          SUBROUTINE MOM_VI_V_CORIOLIS_C4(
10         I        bi,bj,k,
11       I        uFld,omega3,r_hFacZ,       I        uFld,omega3,r_hFacZ,
12       O        vCoriolisTerm,       O        vCoriolisTerm,
13       I        myThid)       I        myThid)
14    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        IMPLICIT NONE        IMPLICIT NONE
 C     /==========================================================\  
 C     | S/R MOM_VI_V_CORIOLIS                                    |  
 C     |==========================================================|  
 C     \==========================================================/  
25    
26  C     == Global variables ==  C     == Global variables ==
27  #include "SIZE.h"  #include "SIZE.h"
# Line 20  C     == Global variables == Line 29  C     == Global variables ==
29  #include "GRID.h"  #include "GRID.h"
30  #include "PARAMS.h"  #include "PARAMS.h"
31    
32    C     !INPUT/OUTPUT PARAMETERS:
33  C     == Routine arguments ==  C     == Routine arguments ==
34        INTEGER bi,bj,K        INTEGER bi,bj,k
35        _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
36        _RL omega3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL omega3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38        _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
39        INTEGER myThid        INTEGER myThid
40    CEOP
41    
42  C     == Local variables ==  C     == Local variables ==
43        INTEGER I,J        INTEGER i,j
44        _RL uBarXY,vort3v,Rjp,Rjm        _RL uBarXY,vort3v,Rjp,Rjm
45          _RL uBarYm,uBarYp,oneSixth
46        LOGICAL upwindVort3        LOGICAL upwindVort3
47        LOGICAL fourthVort3        LOGICAL fourthVort3
48    
49        upwindVort3=.FALSE.        PARAMETER(oneSixth=1.D0/6.D0)
50        fourthVort3=.TRUE.        PARAMETER(upwindVort3=.FALSE.)
51          PARAMETER(fourthVort3=.TRUE. )
52    
53    c     DO j=2-Oly,sNy+Oly
54    c      DO i=2-Olx,sNx+Olx-2
55          DO j=1,sNy+1
56           DO i=1,sNx
57    
58            IF ( SadournyCoriolis ) THEN
59    C-      using SadournyCoriolis discretization:
60    
61             uBarXY=1.
62             uBarYm=0.5*(
63         &       uFld( i , j )*dyG( i , j ,bi,bj)*hFacW( i , j ,k,bi,bj)
64         &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacW( i ,j-1,k,bi,bj) )
65             uBarYp=0.5*(
66         &       uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacW(i+1, j ,k,bi,bj)
67         &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacW(i+1,j-1,k,bi,bj) )
68             IF (upwindVorticity) THEN
69              IF ( (uBarYm+uBarYp) .GT.0.) THEN
70               vort3v=uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
71              ELSE
72               vort3v=uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
73              ENDIF
74             ELSEIF (fourthVort3) THEN
75              Rjp = omega3(i+1,j)*r_hFacZ(i+1,j)
76         &         -oneSixth*( omega3(i+2,j)*r_hFacZ(i+2,j)
77         &                    -omega3( i ,j)*r_hFacZ( i ,j) )
78              Rjm = omega3(i,j)*r_hFacZ(i,j)
79         &         +oneSixth*( omega3(i+1,j)*r_hFacZ(i+1,j)
80         &                    -omega3(i-1,j)*r_hFacZ(i-1,j) )
81              vort3v=0.5*( uBarYm*Rjm + uBarYp*Rjp )
82             ELSE
83              vort3v=0.5*( uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
84         &                +uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j) )
85             ENDIF
86    
87            ELSE
88    C-      not using SadournyCoriolis discretization:
89    
        DO J=2-Oly,sNy+Oly  
         DO I=1-Olx,sNx+Olx-1  
90           uBarXY=0.25*(           uBarXY=0.25*(
91       &       uFld( i , j )*dyG( i , j ,bi,bj)*hFacW( i , j ,k,bi,bj)       &       uFld( i , j )*dyG( i , j ,bi,bj)*hFacW( i , j ,k,bi,bj)
92       &      +uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacW(i+1, j ,k,bi,bj)       &      +uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacW(i+1, j ,k,bi,bj)
93       &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacW( i ,j-1,k,bi,bj)       &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacW( i ,j-1,k,bi,bj)
94       &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacW(i+1,j-1,k,bi,bj))       &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacW(i+1,j-1,k,bi,bj))
 c        uBarXY=0.25*( uFld(i, j )+uFld(i+1, j )  
 c    &                +uFld(i,j-1)+uFld(i+1,j-1))  
95           IF (upwindVort3) THEN           IF (upwindVort3) THEN
96            IF (uBarXY.GT.0.) THEN            IF (uBarXY.GT.0.) THEN
97             vort3v=omega3(i,j)*r_hFacZ(i,j)             vort3v=omega3(i,j)*r_hFacZ(i,j)
# Line 66  c    &                +uFld(i,j-1)+uFld( Line 112  c    &                +uFld(i,j-1)+uFld(
112       &               +omega3(i+1,j)*r_hFacZ(i+1,j))       &               +omega3(i+1,j)*r_hFacZ(i+1,j))
113           ENDIF           ENDIF
114    
115  cph(  C-      end if / else SadournyCoriolis
116  cph The following block with 'interlaced' comments          ENDIF
117  cph is bad for TAMC and will be replaced  
118  cph)          vCoriolisTerm(i,j)=
119  #undef THIS_IS_BAD_FOR_TAMC       &   -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
120  #ifdef THIS_IS_BAD_FOR_TAMC       &                 * _maskS(i,j,k,bi,bj)
          vCoriolisTerm(i,j)=  
 C high order vorticity advection term  
      &   -vort3v*uBarXY*recip_dyc(i,j,bi,bj)  
 C linear Coriolis term  
 c    &   -0.5 *(fCoriG(I,J,bi,bj)+fCoriG(I+1,J,bi,bj))*uBarXY  
 C full nonlinear Coriolis term  
 c    &   -0.5*(omega3(I,J)+omega3(I+1,J))*uBarXY  
 C correct energy conserving form of Coriolis term  
 c    &   -0.5 *( fCori(I,J  ,bi,bj)*uBarX(I,J  ,K,bi,bj) +  
 c    &           fCori(I,J-1,bi,bj)*uBarX(I,J-1,K,bi,bj)  )  
 C original form of Coriolis term (copied from calc_mom_rhs)  
 c    &   -0.5*(fCori(i,j,bi,bj)+fCori(i,j-1,bi,bj))*uBarXY  
      &   *_maskS(I,J,K,bi,bj)  
 #else  
          vCoriolisTerm(i,j)=  
      &   -vort3v*uBarXY*recip_dyc(i,j,bi,bj)  
      &   *_maskS(I,J,K,bi,bj)  
 #endif  
121    
         ENDDO  
122         ENDDO         ENDDO
123          ENDDO
124    
125        RETURN        RETURN
126        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22