/[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.7 by heimbach, Wed Jun 7 01:55:15 2006 UTC revision 1.8 by jmc, Mon Jun 12 21:15:26 2006 UTC
# Line 26  C     !USES: Line 26  C     !USES:
26  C     == Global variables ==  C     == Global variables ==
27  #include "SIZE.h"  #include "SIZE.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "GRID.h"  
29  #include "PARAMS.h"  #include "PARAMS.h"
30    #include "GRID.h"
31    #ifdef ALLOW_EXCH2
32    #include "W2_EXCH2_TOPOLOGY.h"
33    #include "W2_EXCH2_PARAMS.h"
34    #endif /* ALLOW_EXCH2 */
35    
36  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
37  C     == Routine arguments ==  C     == Routine arguments ==
# Line 41  CEOP Line 45  CEOP
45    
46  C     == Local variables ==  C     == Local variables ==
47        INTEGER i,j        INTEGER i,j
48          _RL vort3r(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49        _RL vBarXY,vort3u,Rjp,Rjm        _RL vBarXY,vort3u,Rjp,Rjm
50        _RL vBarXm,vBarXp,oneSixth        _RL vBarXm,vBarXp
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        LOGICAL upwindVort3        LOGICAL upwindVort3
60        LOGICAL fourthVort3        LOGICAL fourthVort3
61          PARAMETER(oneSixth=1.D0/6.D0 , oneTwelve=1.D0/12.D0)
       PARAMETER(oneSixth=1.D0/6.D0)  
62        PARAMETER(upwindVort3=.FALSE.)        PARAMETER(upwindVort3=.FALSE.)
63        PARAMETER(fourthVort3=.TRUE. )        PARAMETER(fourthVort3=.TRUE. )
64    
65    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,j-1) = ( vort3r(i,j-1) + vort3r(i+1,j) )*0.5 _d 0
98           ENDIF
99           IF ( southEastCorner ) THEN
100             i = sNx+1
101             j = 1
102             vort3r(i,j-1) = ( vort3r(i,j-1) + vort3r(i-1,j) )*0.5 _d 0
103           ENDIF
104           IF ( northWestCorner ) THEN
105             i = 1
106             j = sNy+1
107             vort3r(i,j+1) = ( vort3r(i,j+1) + vort3r(i+1,j) )*0.5 _d 0
108           ENDIF
109           IF ( northEastCorner ) THEN
110             i = sNx+1
111             j = sNy+1
112             vort3r(i,j+1) = ( vort3r(i,j+1) + vort3r(i-1,j) )*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  c     DO j=2-Oly,sNy+Oly-2  c     DO j=2-Oly,sNy+Oly-2
120  c      DO i=2-Olx,sNx+Olx  c      DO i=2-Olx,sNx+Olx
121        DO j=1,sNy        DO j=1,sNy
# Line 67  C-      using SadournyCoriolis discretiz Line 133  C-      using SadournyCoriolis discretiz
133       &      +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) )
134           IF (upwindVorticity) THEN           IF (upwindVorticity) THEN
135            IF ( (vBarXm+vBarXp) .GT.0.) THEN            IF ( (vBarXm+vBarXp) .GT.0.) THEN
136             vort3u=vBarXm*r_hFacZ(i, j )*omega3(i, j )             vort3u=vBarXm*vort3r(i, j )
137            ELSE            ELSE
138             vort3u=vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1)             vort3u=vBarXp*vort3r(i,j+1)
139            ENDIF            ENDIF
140           ELSEIF (fourthVort3) THEN           ELSEIF (fourthVort3) THEN
141            Rjp = omega3(i,j+1)*r_hFacZ(i,j+1)            Rjp = vort3r(i,j+1) -oneSixth*( vort3r(i,j+2)-vort3r(i, j ) )
142       &         -oneSixth*( omega3(i,j+2)*r_hFacZ(i,j+2)            Rjm = vort3r(i, j ) +oneSixth*( vort3r(i,j+1)-vort3r(i,j-1) )
      &                    -omega3(i, j )*r_hFacZ(i, j ) )  
           Rjm = omega3(i,j)*r_hFacZ(i,j)  
      &         +oneSixth*( omega3(i,j+1)*r_hFacZ(i,j+1)  
      &                    -omega3(i,j-1)*r_hFacZ(i,j-1) )  
143            vort3u=0.5*( vBarXm*Rjm + vBarXp*Rjp )            vort3u=0.5*( vBarXm*Rjm + vBarXp*Rjp )
144           ELSE           ELSE
145            vort3u=0.5*( vBarXm*r_hFacZ(i, j )*omega3(i, j )            vort3u=0.5*( vBarXm*vort3r(i, j ) + vBarXp*vort3r(i,j+1) )
      &               + vBarXp*r_hFacZ(i,j+1)*omega3(i,j+1) )  
146           ENDIF           ENDIF
147    
148          ELSE          ELSE
# Line 95  C-      not using SadournyCoriolis discr Line 156  C-      not using SadournyCoriolis discr
156       &               )       &               )
157           IF (upwindVort3) THEN           IF (upwindVort3) THEN
158            IF (vBarXY.GT.0.) THEN            IF (vBarXY.GT.0.) THEN
159             vort3u=omega3(i,j)*r_hFacZ(i,j)             vort3u=vort3r(i,j)
160            ELSE            ELSE
161             vort3u=omega3(i,j+1)*r_hFacZ(i,j+1)             vort3u=vort3r(i,j+1)
162            ENDIF            ENDIF
163           ELSEIF (fourthVort3) THEN           ELSEIF (fourthVort3) THEN
164            Rjp=omega3(i,j+2)*r_hFacZ(i,j+2)            Rjp = vort3r(i,j+2) - vort3r(i,j+1)
165       &       -omega3(i,j+1)*r_hFacZ(i,j+1)            Rjm = vort3r(i, j ) - vort3r(i,j-1)
166            Rjm=omega3(i,j)*r_hFacZ(i,j)            vort3u=0.5*( vort3r(i,j) + vort3r(i,j+1)
167       &       -omega3(i,j-1)*r_hFacZ(i,j-1)       &                -oneTwelve*(Rjp-Rjm)
           vort3u=0.5*(omega3(i,j)*r_hFacZ(i,j)  
      &               +omega3(i,j+1)*r_hFacZ(i,j+1)  
      &               -1./12.*(Rjp-Rjm)  
168       &               )       &               )
169           ELSE           ELSE
170            vort3u=0.5*(omega3(i,j)*r_hFacZ(i,j)            vort3u=0.5*( vort3r(i,j) + vort3r(i,j+1) )
      &               +omega3(i,j+1)*r_hFacZ(i,j+1))  
171           ENDIF           ENDIF
172    
173  C-      end if / else SadournyCoriolis  C-      end if / else SadournyCoriolis
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22