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

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

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

revision 1.9 by jmc, Sun Mar 30 21:46:48 2008 UTC revision 1.10 by jmc, Tue Apr 1 01:27:33 2008 UTC
# Line 15  C     !DESCRIPTION: \bv Line 15  C     !DESCRIPTION: \bv
15  C     *==========================================================*  C     *==========================================================*
16  C     | S/R MOM_VI_U_CORIOLIS_C4  C     | S/R MOM_VI_U_CORIOLIS_C4
17  C     |==========================================================*  C     |==========================================================*
18  C     | o Calculate meridional flux of vorticity at U point  C     | o Calculate flux (in Y-dir.) of vorticity at U point
19  C     |   using 4th order interpolation  C     |   using 4th order (or 1rst order) interpolation
20  C     *==========================================================*  C     *==========================================================*
21  C     \ev  C     \ev
22    
# Line 44  C     == Routine arguments == Line 44  C     == Routine arguments ==
44  CEOP  CEOP
45    
46  C     == Local variables ==  C     == Local variables ==
47    C     msgBuf :: Informational/error meesage buffer
48          CHARACTER*(MAX_LEN_MBUF) msgBuf
49        INTEGER i,j        INTEGER i,j
50        _RL vort3r(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vort3r(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51        _RL vBarXY,vort3u,Rjp,Rjm        _RL vBarXY,vort3u,Rjp,Rjm
# Line 56  C     == Local variables == Line 58  C     == Local variables ==
58        INTEGER myTile        INTEGER myTile
59  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
60        _RL oneSixth, oneTwelve        _RL oneSixth, oneTwelve
       LOGICAL upwindVort3  
61        LOGICAL fourthVort3        LOGICAL fourthVort3
62        PARAMETER(oneSixth=1.D0/6.D0 , oneTwelve=1.D0/12.D0)        PARAMETER(oneSixth=1.D0/6.D0 , oneTwelve=1.D0/12.D0)
       PARAMETER(upwindVort3=.FALSE.)  
63        PARAMETER(fourthVort3=.TRUE. )        PARAMETER(fourthVort3=.TRUE. )
64    
65  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 71  C---+----1----+----2----+----3----+----4 Line 71  C---+----1----+----2----+----3----+----4
71        ENDDO        ENDDO
72    
73  C--   Special stuff for Cubed Sphere  C--   Special stuff for Cubed Sphere
74        IF (useCubedSphereExchange) THEN        IF ( useCubedSphereExchange.AND.highOrderVorticity ) THEN
75    
76  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
77         myTile = W2_myTileList(bi)         myTile = W2_myTileList(bi)
# Line 116  C--   End of special stuff for Cubed Sph Line 116  C--   End of special stuff for Cubed Sph
116        ENDIF        ENDIF
117    
118  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 c     DO j=2-Oly,sNy+Oly-2  
 c      DO i=2-Olx,sNx+Olx  
       DO j=1,sNy  
        DO i=1,sNx+1  
119    
120          IF ( selectVortScheme.EQ.2 ) THEN        IF ( selectVortScheme.EQ.0 ) THEN
121  C-      using SadournyCoriolis discretization:  C--   using Sadourny Enstrophy conserving discretization:
122    
123           vBarXY=1.  c      DO j=2-Oly,sNy+Oly-2
124           vBarXm=0.5*(  c       DO i=2-Olx,sNx+Olx
125       &       vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)         DO j=1,sNy
126       &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj) )          DO i=1,sNx+1
          vBarXp=0.5*(  
      &       vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)  
      &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj) )  
          IF (upwindVorticity) THEN  
           IF ( (vBarXm+vBarXp) .GT.0.) THEN  
            vort3u=vBarXm*vort3r(i, j )  
           ELSE  
            vort3u=vBarXp*vort3r(i,j+1)  
           ENDIF  
          ELSEIF (fourthVort3) THEN  
           Rjp = vort3r(i,j+1) -oneSixth*( vort3r(i,j+2)-vort3r(i, j ) )  
           Rjm = vort3r(i, j ) +oneSixth*( vort3r(i,j+1)-vort3r(i,j-1) )  
           vort3u=0.5*( vBarXm*Rjm + vBarXp*Rjp )  
          ELSE  
           vort3u=0.5*( vBarXm*vort3r(i, j ) + vBarXp*vort3r(i,j+1) )  
          ENDIF  
   
         ELSE  
 C-      not using SadournyCoriolis discretization:  
127    
128           vBarXY=0.25*(           vBarXY=0.25*(
129       &      (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)       &      (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
# Line 154  C-      not using SadournyCoriolis discr Line 131  C-      not using SadournyCoriolis discr
131       &     +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)       &     +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
132       &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj))       &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj))
133       &               )       &               )
134           IF (upwindVort3) THEN           IF (upwindVorticity) THEN
135            IF (vBarXY.GT.0.) THEN            IF (vBarXY.GT.0.) THEN
136             vort3u=vort3r(i,j)             vort3u=vort3r(i,j)
137            ELSE            ELSE
# Line 170  C-      not using SadournyCoriolis discr Line 147  C-      not using SadournyCoriolis discr
147            vort3u=0.5*( vort3r(i,j) + vort3r(i,j+1) )            vort3u=0.5*( vort3r(i,j) + vort3r(i,j+1) )
148           ENDIF           ENDIF
149    
150  C-      end if / else SadournyCoriolis           uCoriolisTerm(i,j) =  vort3u*vBarXY*recip_dxC(i,j,bi,bj)
151          ENDIF       &                               * _maskW(i,j,k,bi,bj)
152    
153            ENDDO
154           ENDDO
155    
156          ELSEIF ( selectVortScheme.EQ.2 ) THEN
157    C--   using Energy conserving discretization:
158    
159          uCoriolisTerm(i,j)=  c      DO j=2-Oly,sNy+Oly-2
160       &    vort3u*vBarXY*recip_dxC(i,j,bi,bj)  c       DO i=2-Olx,sNx+Olx
161       &                 * _maskW(i,j,k,bi,bj)         DO j=1,sNy
162            DO i=1,sNx+1
163    
164             vBarXm=0.5*(
165         &       vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
166         &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj) )
167             vBarXp=0.5*(
168         &       vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
169         &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj) )
170             IF (upwindVorticity) THEN
171              IF ( (vBarXm+vBarXp) .GT.0.) THEN
172               vort3u=vBarXm*vort3r(i, j )
173              ELSE
174               vort3u=vBarXp*vort3r(i,j+1)
175              ENDIF
176             ELSEIF (fourthVort3) THEN
177              Rjp = vort3r(i,j+1) -oneSixth*( vort3r(i,j+2)-vort3r(i, j ) )
178              Rjm = vort3r(i, j ) +oneSixth*( vort3r(i,j+1)-vort3r(i,j-1) )
179              vort3u=0.5*( vBarXm*Rjm + vBarXp*Rjp )
180             ELSE
181              vort3u=0.5*( vBarXm*vort3r(i, j ) + vBarXp*vort3r(i,j+1) )
182             ENDIF
183    
184             uCoriolisTerm(i,j) =  vort3u*recip_dxC(i,j,bi,bj)
185         &                               * _maskW(i,j,k,bi,bj)
186    
187            ENDDO
188         ENDDO         ENDDO
189        ENDDO  
190          ELSE
191            WRITE(msgBuf,'(A,I5,A)')
192         &   'MOM_VI_U_CORIOLIS_C4: selectVortScheme=', selectVortScheme,
193         &   ' not implemented'
194            CALL PRINT_ERROR( msgBuf, myThid )
195            STOP 'ABNORMAL END: S/R MOM_VI_U_CORIOLIS_C4'
196    
197          ENDIF
198    
199        RETURN        RETURN
200        END        END
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22