/[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.7 by jmc, Wed Jun 22 00:33:14 2005 UTC revision 1.9 by jmc, Wed Sep 28 15:53:20 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_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 31  C     == Local variables == Line 31  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        _RL vZm,vZp
34          LOGICAL  rAdvAreaWeight
35  c     _RL vmask_Kp1,vmask_K,vmask_Km1  c     _RL vmask_Kp1,vmask_K,vmask_Km1
36  c     LOGICAL freeslipK,noslipK  c     LOGICAL freeslipK,noslipK
37  c     PARAMETER(freeslipK=.TRUE.)  c     PARAMETER(freeslipK=.TRUE.)
# Line 40  c     PARAMETER(freeslip1=.TRUE.) Line 41  c     PARAMETER(freeslip1=.TRUE.)
41  c     PARAMETER(noslip1=.NOT.freeslip1)  c     PARAMETER(noslip1=.NOT.freeslip1)
42  c1    _RL wBarYZ,vZbarZ  c1    _RL wBarYZ,vZbarZ
43    
44          rAdvAreaWeight =.TRUE.
45    C-    Area-weighted average either in KE or in vert. advection:
46          IF ( selectKEscheme.EQ.1 .OR. selectKEscheme.EQ.3 )
47         &  rAdvAreaWeight =.FALSE.
48    
49        Kp1=min(K+1,Nr)        Kp1=min(K+1,Nr)
50        mask_Kp1=1.        mask_Kp1=1.
51        IF (K.EQ.Nr) mask_Kp1=0.        IF (K.EQ.Nr) mask_Kp1=0.
# Line 57  c       wBarYm=0.5*(wFld(I,J,K,bi,bj)+wF Line 63  c       wBarYm=0.5*(wFld(I,J,K,bi,bj)+wF
63  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))
64  c    &              *mask_Kp1  c    &              *mask_Kp1
65    
66  C       Transport at interface k         IF ( rAdvAreaWeight ) THEN
67    C       Transport at interface k : Area weighted average
68          wBarYm=0.5*(          wBarYm=0.5*(
69       &    wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)*maskC(i,j,Km1,bi,bj)       &    wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)*maskC(i,j,Km1,bi,bj)
70       &   +wFld(I,J-1,K,bi,bj)*rA(i,j-1,bi,bj)*maskC(i,j-1,Km1,bi,bj)       &   +wFld(I,J-1,K,bi,bj)*rA(i,j-1,bi,bj)*maskC(i,j-1,Km1,bi,bj)
71       &             )*mask_Km1       &             )*mask_Km1
72         &              *recip_rAs(i,j,bi,bj)
73    
74  C       Transport at interface k+1 (here wFld is already masked)  C       Transport at interface k+1 (here wFld is already masked)
75          wBarYp=0.5*(          wBarYp=0.5*(
76       &    wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)       &    wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)
77       &   +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj)       &   +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj)
78       &             )*mask_Kp1       &             )*mask_Kp1
79         &              *recip_rAs(i,j,bi,bj)
80           ELSE
81    C       Transport at interface k : simple average
82            wBarYm=0.5*(
83         &    wFld(I,J,K,bi,bj)*maskC(i,j,Km1,bi,bj)
84         &   +wFld(I,J-1,K,bi,bj)*maskC(i,j-1,Km1,bi,bj)
85         &             )*mask_Km1
86    
87    C       Transport at interface k+1 (here wFld is already masked)
88            wBarYp=0.5*(
89         &    wFld(I,J,Kp1,bi,bj)
90         &   +wFld(I,J-1,Kp1,bi,bj)
91         &             )*mask_Kp1
92           ENDIF
93    
94  C delta_Z( V )  @ interface k  C delta_Z( V )  @ interface k
95  c       vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)  c       vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
# Line 101  c2   &                  *_maskS(I,J,K,bi Line 123  c2   &                  *_maskS(I,J,K,bi
123            vShearTerm(I,J)=-0.5*            vShearTerm(I,J)=-0.5*
124       &                   (     (wBarYp*vZp+wBarYm*vZm)       &                   (     (wBarYp*vZp+wBarYm*vZm)
125       &                        +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)       &                        +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)
126       &                   )*recip_rAs(i,j,bi,bj)       &                   )*recip_hFacS(i,j,k,bi,bj)
      &                    *recip_hFacS(i,j,k,bi,bj)  
127       &                    *recip_drF(K)       &                    *recip_drF(K)
128    c3   &                    *recip_rAs(i,j,bi,bj)
129          ELSE          ELSE
130            vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)            vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
      &                    *recip_rAs(i,j,bi,bj)  
131       &                    *recip_hFacS(i,j,k,bi,bj)       &                    *recip_hFacS(i,j,k,bi,bj)
132       &                    *recip_drF(K)       &                    *recip_drF(K)
133    c3   &                    *recip_rAs(i,j,bi,bj)
134          ENDIF          ENDIF
135         ENDDO         ENDDO
136        ENDDO        ENDDO
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22