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

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

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

revision 1.1 by adcroft, Fri Mar 30 21:13:34 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:39 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "CPP_OPTIONS.h"
5    
6          SUBROUTINE MOM_VI_U_VERTSHEAR(
7         I        bi,bj,K,
8         I        uFld,wFld,
9         U        uShearTerm,
10         I        myThid)
11          IMPLICIT NONE
12    C     /==========================================================\
13    C     | S/R MOM_U_VERTSHEAR                                      |
14    C     |==========================================================|
15    C     \==========================================================/
16    
17    C     == Global variables ==
18    #include "SIZE.h"
19    #include "EEPARAMS.h"
20    #include "GRID.h"
21    #include "PARAMS.h"
22    
23    C     == Routine arguments ==
24          INTEGER bi,bj,K
25          _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26          _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
27          _RL uShearTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
28          INTEGER myThid
29    
30    C     == Local variables ==
31          INTEGER I,J,Kp1,Km1
32          _RL  mask_Kp1,mask_Km1,wBarXm,wBarXp
33          _RL  uZm,uZp,umask_Kp1,umask_K,umask_Km1
34          LOGICAL freeslipK,noslipK
35          PARAMETER(freeslipK=.TRUE.)
36          PARAMETER(noslipK=.NOT.freeslipK)
37          LOGICAL freeslip1,noslip1
38          PARAMETER(freeslip1=.TRUE.)
39          PARAMETER(noslip1=.NOT.freeslip1)
40    c1    _RL  wBarXZ,uZbarZ
41    c1    LOGICAL upwindShear
42    c1    PARAMETER(upwindShear=.FALSE.)
43    
44          Kp1=min(K+1,Nr)
45          mask_Kp1=1.
46          IF (K.EQ.Nr) mask_Kp1=0.
47          Km1=max(K-1,1)
48          mask_Km1=1.
49          IF (K.EQ.1) mask_Km1=0.
50    
51          DO J=2-Oly,sNy+Oly
52           DO I=1-Olx,sNx+Olx
53    
54            umask_K=_maskW(i,j,k,bi,bj)
55    
56    C barZ( barX( W ) )
57    c       wBarXm=0.5*(wFld(I,J,K,bi,bj)+wFld(I-1,J,K,bi,bj))
58    c       wBarXp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I-1,J,Kp1,bi,bj))
59    c    &         *mask_Kp1
60    
61    C       Transport at interface k
62            wBarXm=0.5*(wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)
63         &             +wFld(I-1,J,K,bi,bj)*rA(i-1,j,bi,bj))
64    
65    C       Transport at interface k+1
66            wBarXp=0.5*(wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)
67         &             +wFld(I-1,J,Kp1,bi,bj)*rA(i-1,j,bi,bj))*mask_Kp1
68    
69    C delta_Z( U )  @ interface k
70            umask_Km1=mask_Km1*umask_K
71            uZm=(umask_Km1*uFld(I,J,Km1,bi,bj)-uFld(I,J,K,bi,bj))
72    c2   &      *recip_dRC(K)
73            IF (freeslip1) uZm=uZm*umask_Km1
74            IF (noslip1.AND.umask_Km1.EQ.0.) uZm=uZm*2.
75    
76    C delta_Z( U )  @ interface k+1
77            umask_Kp1=mask_Kp1*umask_K
78            uZp=(uFld(I,J,K,bi,bj)-umask_Kp1*uFld(I,J,Kp1,bi,bj))
79    c2   &      *recip_dRC(Kp1)
80            IF (freeslipK) uZp=uZp*umask_Kp1
81            IF (noslipK.AND.umask_Kp1.EQ.0.) uZp=uZp*2.
82    
83    c1      IF (upwindShear) THEN
84    c1       wBarXZ=0.5*( wBarXm + wBarXp )
85    c1       IF (wBarXZ.GT.0.) THEN
86    c1        uZbarZ=uZp
87    c1       ELSE
88    c1        uZbarZ=uZm
89    c1       ENDIF
90    c1      ELSE
91    c1       uZbarZ=0.5*(uZm+uZp)
92    c1      ENDIF
93    c1      uShearTerm(I,J)=-wBarXZ*uZbarZ*_maskW(I,J,K,bi,bj)
94    
95    c2      uShearTerm(I,J)=-0.5*(wBarXp*uZp+wBarXm*uZm)
96    c2   &                  *_maskW(I,J,K,bi,bj)
97            uShearTerm(I,J)=-0.5*(wBarXp*uZp+wBarXm*uZm)
98         &                  *recip_raw(i,j,bi,bj)
99         &                  *recip_hFacW(i,j,k,bi,bj)
100         &                  *recip_dRF(K)
101           ENDDO
102          ENDDO
103    
104          RETURN
105          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22