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

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

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

revision 1.3 by jmc, Thu Sep 6 17:59:35 2001 UTC revision 1.8 by jmc, Tue Sep 27 23:42:06 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "MOM_VECINV_OPTIONS.h"
5    
6        SUBROUTINE MOM_VI_V_VERTSHEAR(        SUBROUTINE MOM_VI_V_VERTSHEAR(
7       I        bi,bj,K,       I        bi,bj,K,
8       I        vFld,wFld,       I        vFld,wFld,
9       U        vShearTerm,       U        vShearTerm,
10       I        myThid)       I        myThid)
11        IMPLICIT NONE        IMPLICIT NONE
12  C     /==========================================================\  C     *==========================================================*
13  C     | S/R MOM_V_VERTSHEAR                                      |  C     | S/R MOM_V_VERTSHEAR
14  C     |==========================================================|  C     *==========================================================*
15  C     \==========================================================/  C     *==========================================================*
16    
17  C     == Global variables ==  C     == Global variables ==
18  #include "SIZE.h"  #include "SIZE.h"
# Line 30  C     == Routine arguments == Line 30  C     == Routine arguments ==
30  C     == Local variables ==  C     == Local variables ==
31        INTEGER I,J,Kp1,Km1        INTEGER I,J,Kp1,Km1
32        _RL mask_Kp1,mask_Km1,wBarYm,wBarYp        _RL mask_Kp1,mask_Km1,wBarYm,wBarYp
33        _RL vZm,vZp,vmask_Kp1,vmask_K,vmask_Km1        _RL vZm,vZp
34        LOGICAL freeslipK,noslipK        LOGICAL  rAdvAreaWeight
35        PARAMETER(freeslipK=.TRUE.)        PARAMETER( rAdvAreaWeight =.TRUE.)
36        PARAMETER(noslipK=.NOT.freeslipK)  c     _RL vmask_Kp1,vmask_K,vmask_Km1
37        LOGICAL freeslip1,noslip1  c     LOGICAL freeslipK,noslipK
38        PARAMETER(freeslip1=.TRUE.)  c     PARAMETER(freeslipK=.TRUE.)
39        PARAMETER(noslip1=.NOT.freeslip1)  c     PARAMETER(noslipK=.NOT.freeslipK)
40    c     LOGICAL freeslip1,noslip1
41    c     PARAMETER(freeslip1=.TRUE.)
42    c     PARAMETER(noslip1=.NOT.freeslip1)
43  c1    _RL wBarYZ,vZbarZ  c1    _RL wBarYZ,vZbarZ
 c1    LOGICAL upwindShear  
 c1    PARAMETER(upwindShear=.FALSE.)  
44    
45        Kp1=min(K+1,Nr)        Kp1=min(K+1,Nr)
46        mask_Kp1=1.        mask_Kp1=1.
# Line 58  c       wBarYm=0.5*(wFld(I,J,K,bi,bj)+wF Line 59  c       wBarYm=0.5*(wFld(I,J,K,bi,bj)+wF
59  c       wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I,J-1,Kp1,bi,bj))  c       wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I,J-1,Kp1,bi,bj))
60  c    &              *mask_Kp1  c    &              *mask_Kp1
61    
62  C       Transport at interface k         IF ( rAdvAreaWeight ) THEN
63          wBarYm=0.5*(wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)  C       Transport at interface k : Area weighted average
64       &             +wFld(I,J-1,K,bi,bj)*rA(i,j-1,bi,bj))          wBarYm=0.5*(
65         &    wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)*maskC(i,j,Km1,bi,bj)
66  C       Transport at interface k+1       &   +wFld(I,J-1,K,bi,bj)*rA(i,j-1,bi,bj)*maskC(i,j-1,Km1,bi,bj)
67          wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)       &             )*mask_Km1
68       &             +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj))*mask_Kp1       &              *recip_rAs(i,j,bi,bj)
69    
70    C       Transport at interface k+1 (here wFld is already masked)
71            wBarYp=0.5*(
72         &    wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)
73         &   +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj)
74         &             )*mask_Kp1
75         &              *recip_rAs(i,j,bi,bj)
76           ELSE
77    C       Transport at interface k : simple average
78            wBarYm=0.5*(
79         &    wFld(I,J,K,bi,bj)*maskC(i,j,Km1,bi,bj)
80         &   +wFld(I,J-1,K,bi,bj)*maskC(i,j-1,Km1,bi,bj)
81         &             )*mask_Km1
82    
83    C       Transport at interface k+1 (here wFld is already masked)
84            wBarYp=0.5*(
85         &    wFld(I,J,Kp1,bi,bj)
86         &   +wFld(I,J-1,Kp1,bi,bj)
87         &             )*mask_Kp1
88           ENDIF
89    
90  C delta_Z( V )  @ interface k  C delta_Z( V )  @ interface k
91          vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)  c       vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
92          vZm=(mask_Km1*vFld(I,J,Km1,bi,bj)-vFld(I,J,K,bi,bj))          vZm=(vFld(I,J,K,bi,bj)-mask_Km1*vFld(I,J,Km1,bi,bj))*rkSign
93  c2   &      *recip_dRC(K)  c2   &      *recip_dRC(K)
94          IF (freeslip1) vZm=vZm*vmask_Km1  c       IF (freeslip1) vZm=vZm*vmask_Km1
95          IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.  c       IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.
96    
97  C delta_Z( V )  @ interface k+1  C delta_Z( V )  @ interface k+1
98          vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)  c       vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)
99          vZp=(vFld(I,J,K,bi,bj)-mask_Kp1*vFld(I,J,Kp1,bi,bj))          vZp=(mask_Kp1*vFld(I,J,Kp1,bi,bj)-vFld(I,J,K,bi,bj))*rkSign
100  c2   &      *recip_dRC(Kp1)  c2   &      *recip_dRC(Kp1)
101          IF (freeslipK) vZp=vZp*vmask_Kp1  c       IF (freeslipK) vZp=vZp*vmask_Kp1
102          IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.  c       IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.
103    
104  c1      IF (upwindShear) THEN  c1      IF (upwindShear) THEN
105  c1       wBarYZ=0.5*( wBarXm + wBarXp )  c1       wBarYZ=0.5*( wBarXm + wBarXp )
# Line 94  c1      vShearTerm(I,J)=-wBarYZ*vZbarZ*_ Line 115  c1      vShearTerm(I,J)=-wBarYZ*vZbarZ*_
115    
116  c2      vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)  c2      vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
117  c2   &                  *_maskS(I,J,K,bi,bj)  c2   &                  *_maskS(I,J,K,bi,bj)
118          vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)          IF (upwindShear) THEN
119       &                  *recip_ras(i,j,bi,bj)            vShearTerm(I,J)=-0.5*
120       &                  *recip_hFacS(i,j,k,bi,bj)       &                   (     (wBarYp*vZp+wBarYm*vZm)
121       &                  *recip_dRF(K)       &                        +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)
122         &                   )*recip_hFacS(i,j,k,bi,bj)
123         &                    *recip_drF(K)
124    c3   &                    *recip_rAs(i,j,bi,bj)
125            ELSE
126              vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
127         &                    *recip_hFacS(i,j,k,bi,bj)
128         &                    *recip_drF(K)
129    c3   &                    *recip_rAs(i,j,bi,bj)
130            ENDIF
131         ENDDO         ENDDO
132        ENDDO        ENDDO
133    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22