/[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.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 9  C $Name$ Line 9  C $Name$
9       U        uShearTerm,       U        uShearTerm,
10       I        myThid)       I        myThid)
11        IMPLICIT NONE        IMPLICIT NONE
12  C     /==========================================================\  C     *==========================================================*
13  C     | S/R MOM_U_VERTSHEAR                                      |  C     | S/R MOM_U_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,wBarXm,wBarXp        _RL  mask_Kp1,mask_Km1,wBarXm,wBarXp
33        _RL  uZm,uZp        _RL  uZm,uZp
34          LOGICAL  rAdvAreaWeight
35          PARAMETER( rAdvAreaWeight =.TRUE.)
36  c     _RL  umask_Kp1,umask_K,umask_Km1  c     _RL  umask_Kp1,umask_K,umask_Km1
37  c     LOGICAL freeslipK,noslipK  c     LOGICAL freeslipK,noslipK
38  c     PARAMETER(freeslipK=.TRUE.)  c     PARAMETER(freeslipK=.TRUE.)
# Line 57  c       wBarXm=0.5*(wFld(I,J,K,bi,bj)+wF Line 59  c       wBarXm=0.5*(wFld(I,J,K,bi,bj)+wF
59  c       wBarXp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I-1,J,Kp1,bi,bj))  c       wBarXp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I-1,J,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          wBarXm=0.5*(          wBarXm=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-1,J,K,bi,bj)*rA(i-1,j,bi,bj)*maskC(I-1,J,Km1,bi,bj)       &   +wFld(I-1,J,K,bi,bj)*rA(i-1,j,bi,bj)*maskC(I-1,J,Km1,bi,bj)
67       &             )*mask_Km1       &             )*mask_Km1
68         &              *recip_rAw(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          wBarXp=0.5*(          wBarXp=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-1,J,Kp1,bi,bj)*rA(i-1,j,bi,bj)       &   +wFld(I-1,J,Kp1,bi,bj)*rA(i-1,j,bi,bj)
74       &             )*mask_Kp1       &             )*mask_Kp1
75         &              *recip_rAw(i,j,bi,bj)
76           ELSE
77    C       Transport at interface k : simple average
78            wBarXm=0.5*(
79         &    wFld(I,J,K,bi,bj)*maskC(I,J,Km1,bi,bj)
80         &   +wFld(I-1,J,K,bi,bj)*maskC(I-1,J,Km1,bi,bj)
81         &             )*mask_Km1
82    
83    C       Transport at interface k+1 (here wFld is already masked)
84            wBarXp=0.5*(
85         &    wFld(I,J,Kp1,bi,bj)
86         &   +wFld(I-1,J,Kp1,bi,bj)
87         &             )*mask_Kp1
88           ENDIF
89    
90  C delta_Z( U )  @ interface k  C delta_Z( U )  @ interface k
91  c       umask_Km1=mask_Km1*maskW(i,j,Km1,bi,bj)  c       umask_Km1=mask_Km1*maskW(i,j,Km1,bi,bj)
# Line 101  c2   &                  *_maskW(I,J,K,bi Line 119  c2   &                  *_maskW(I,J,K,bi
119            uShearTerm(I,J)=-0.5*            uShearTerm(I,J)=-0.5*
120       &                   (     (wBarXp*uZp+wBarXm*uZm)       &                   (     (wBarXp*uZp+wBarXm*uZm)
121       &                        +(ABS(wBarXp)*uZp-ABS(wBarXm)*uZm)       &                        +(ABS(wBarXp)*uZp-ABS(wBarXm)*uZm)
122       &                   )*recip_rAw(i,j,bi,bj)       &                   )*recip_hFacW(i,j,k,bi,bj)
      &                    *recip_hFacW(i,j,k,bi,bj)  
123       &                    *recip_drF(K)       &                    *recip_drF(K)
124    c3   &                    *recip_rAw(i,j,bi,bj)
125          ELSE          ELSE
126            uShearTerm(I,J)=-0.5*(wBarXp*uZp+wBarXm*uZm)            uShearTerm(I,J)=-0.5*(wBarXp*uZp+wBarXm*uZm)
      &                    *recip_rAw(i,j,bi,bj)  
127       &                    *recip_hFacW(i,j,k,bi,bj)       &                    *recip_hFacW(i,j,k,bi,bj)
128       &                    *recip_drF(K)       &                    *recip_drF(K)
129    c3   &                    *recip_rAw(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