/[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.8 by jmc, Tue Sep 27 23:42:06 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          PARAMETER( rAdvAreaWeight =.TRUE.)
36  c     _RL vmask_Kp1,vmask_K,vmask_Km1  c     _RL vmask_Kp1,vmask_K,vmask_Km1
37  c     LOGICAL freeslipK,noslipK  c     LOGICAL freeslipK,noslipK
38  c     PARAMETER(freeslipK=.TRUE.)  c     PARAMETER(freeslipK=.TRUE.)
# Line 57  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    C       Transport at interface k : Area weighted average
64          wBarYm=0.5*(          wBarYm=0.5*(
65       &    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)
66       &   +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)
67       &             )*mask_Km1       &             )*mask_Km1
68         &              *recip_rAs(i,j,bi,bj)
69    
70  C       Transport at interface k+1 (here wFld is already masked)  C       Transport at interface k+1 (here wFld is already masked)
71          wBarYp=0.5*(          wBarYp=0.5*(
72       &    wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)       &    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)       &   +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj)
74       &             )*mask_Kp1       &             )*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  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 119  c2   &                  *_maskS(I,J,K,bi
119            vShearTerm(I,J)=-0.5*            vShearTerm(I,J)=-0.5*
120       &                   (     (wBarYp*vZp+wBarYm*vZm)       &                   (     (wBarYp*vZp+wBarYm*vZm)
121       &                        +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)       &                        +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)
122       &                   )*recip_rAs(i,j,bi,bj)       &                   )*recip_hFacS(i,j,k,bi,bj)
      &                    *recip_hFacS(i,j,k,bi,bj)  
123       &                    *recip_drF(K)       &                    *recip_drF(K)
124    c3   &                    *recip_rAs(i,j,bi,bj)
125          ELSE          ELSE
126            vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)            vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
      &                    *recip_rAs(i,j,bi,bj)  
127       &                    *recip_hFacS(i,j,k,bi,bj)       &                    *recip_hFacS(i,j,k,bi,bj)
128       &                    *recip_drF(K)       &                    *recip_drF(K)
129    c3   &                    *recip_rAs(i,j,bi,bj)
130          ENDIF          ENDIF
131         ENDDO         ENDDO
132        ENDDO        ENDDO
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22