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

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

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


Revision 1.3 - (hide annotations) (download)
Thu Sep 6 17:59:35 2001 UTC (22 years, 8 months ago) by jmc
Branch: MAIN
Changes since 1.2: +7 -7 lines
put the correct mask for bottom and top

1 jmc 1.3 C $Header: /u/gcmpack/models/MITgcmUV/pkg/mom_vecinv/mom_vi_v_vertshear.F,v 1.2 2001/05/29 14:01:39 adcroft Exp $
2     C $Name: $
3 adcroft 1.2
4     #include "CPP_OPTIONS.h"
5    
6     SUBROUTINE MOM_VI_V_VERTSHEAR(
7     I bi,bj,K,
8     I vFld,wFld,
9     U vShearTerm,
10     I myThid)
11     IMPLICIT NONE
12     C /==========================================================\
13     C | S/R MOM_V_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 vFld(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 vShearTerm(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,wBarYm,wBarYp
33     _RL vZm,vZp,vmask_Kp1,vmask_K,vmask_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 wBarYZ,vZbarZ
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 jmc 1.3 DO J=2-Oly,sNy+Oly
52     DO I=1-Olx,sNx+Olx
53 adcroft 1.2
54 jmc 1.3 c vmask_K=_maskS(i,j,k,bi,bj)
55 adcroft 1.2
56     C barZ( barY( W ) )
57     c wBarYm=0.5*(wFld(I,J,K,bi,bj)+wFld(I,J-1,K,bi,bj))
58     c wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I,J-1,Kp1,bi,bj))
59     c & *mask_Kp1
60    
61     C Transport at interface k
62     wBarYm=0.5*(wFld(I,J,K,bi,bj)*rA(i,j,bi,bj)
63     & +wFld(I,J-1,K,bi,bj)*rA(i,j-1,bi,bj))
64    
65     C Transport at interface k+1
66     wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)*rA(i,j,bi,bj)
67     & +wFld(I,J-1,Kp1,bi,bj)*rA(i,j-1,bi,bj))*mask_Kp1
68    
69     C delta_Z( V ) @ interface k
70 jmc 1.3 vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
71 adcroft 1.2 vZm=(mask_Km1*vFld(I,J,Km1,bi,bj)-vFld(I,J,K,bi,bj))
72     c2 & *recip_dRC(K)
73     IF (freeslip1) vZm=vZm*vmask_Km1
74     IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.
75    
76     C delta_Z( V ) @ interface k+1
77 jmc 1.3 vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)
78 adcroft 1.2 vZp=(vFld(I,J,K,bi,bj)-mask_Kp1*vFld(I,J,Kp1,bi,bj))
79     c2 & *recip_dRC(Kp1)
80     IF (freeslipK) vZp=vZp*vmask_Kp1
81     IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.
82    
83     c1 IF (upwindShear) THEN
84     c1 wBarYZ=0.5*( wBarXm + wBarXp )
85     c1 IF (wBarYZ.GT.0.) THEN
86     c1 vZbarZ=vZp
87     c1 ELSE
88     c1 vZbarZ=vZm
89     c1 ENDIF
90     c1 ELSE
91     c1 vZbarZ=0.5*(vZm+vZp)
92     c1 ENDIF
93     c1 vShearTerm(I,J)=-wBarYZ*vZbarZ*_maskS(I,J,K,bi,bj)
94    
95     c2 vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
96     c2 & *_maskS(I,J,K,bi,bj)
97     vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
98     & *recip_ras(i,j,bi,bj)
99     & *recip_hFacS(i,j,k,bi,bj)
100     & *recip_dRF(K)
101     ENDDO
102     ENDDO
103    
104     RETURN
105     END

  ViewVC Help
Powered by ViewVC 1.1.22