/[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.10 - (hide annotations) (download)
Wed Jun 7 01:55:15 2006 UTC (17 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint59, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint63g, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, mitgcm_mapl_00, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint58r_post, checkpoint58n_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint62b, checkpoint58v_post, checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61f, checkpoint58x_post, checkpoint61n, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint61q, checkpoint61e, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.9: +7 -7 lines 
Modifications for bottom topography control
o replace hFacC by _hFacC at various places
o replace ALLOW_HFACC_CONTROL by ALLOW_DEPTH_CONTROL
o add non-self-adjoint cg2d_nsa
o update autodiff support routines
o re-initialise hfac after ctrl_depth_ini
o works for 5x5 box, doesnt work for global_ocean.90x40x15
1 heimbach 1.10 C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_vi_v_vertshear.F,v 1.9 2005/09/28 15:53:20 jmc Exp $
2 jmc 1.3 C $Name: $
3 adcroft 1.2
4 adcroft 1.5 #include "MOM_VECINV_OPTIONS.h"
5 adcroft 1.2
6 jmc 1.8 SUBROUTINE MOM_VI_V_VERTSHEAR(
7 adcroft 1.2 I bi,bj,K,
8     I vFld,wFld,
9     U vShearTerm,
10     I myThid)
11     IMPLICIT NONE
12 jmc 1.8 C *==========================================================*
13     C | S/R MOM_V_VERTSHEAR
14     C *==========================================================*
15     C *==========================================================*
16 adcroft 1.2
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 jmc 1.6 _RL vZm,vZp
34 jmc 1.8 LOGICAL rAdvAreaWeight
35 jmc 1.6 c _RL vmask_Kp1,vmask_K,vmask_Km1
36     c LOGICAL freeslipK,noslipK
37     c PARAMETER(freeslipK=.TRUE.)
38     c PARAMETER(noslipK=.NOT.freeslipK)
39     c LOGICAL freeslip1,noslip1
40     c PARAMETER(freeslip1=.TRUE.)
41     c PARAMETER(noslip1=.NOT.freeslip1)
42 adcroft 1.2 c1 _RL wBarYZ,vZbarZ
43    
44 jmc 1.9 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 adcroft 1.2 Kp1=min(K+1,Nr)
50     mask_Kp1=1.
51     IF (K.EQ.Nr) mask_Kp1=0.
52     Km1=max(K-1,1)
53     mask_Km1=1.
54     IF (K.EQ.1) mask_Km1=0.
55    
56 jmc 1.3 DO J=2-Oly,sNy+Oly
57     DO I=1-Olx,sNx+Olx
58 adcroft 1.2
59 jmc 1.3 c vmask_K=_maskS(i,j,k,bi,bj)
60 adcroft 1.2
61     C barZ( barY( W ) )
62     c wBarYm=0.5*(wFld(I,J,K,bi,bj)+wFld(I,J-1,K,bi,bj))
63     c wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I,J-1,Kp1,bi,bj))
64     c & *mask_Kp1
65    
66 jmc 1.8 IF ( rAdvAreaWeight ) THEN
67     C Transport at interface k : Area weighted average
68 jmc 1.4 wBarYm=0.5*(
69     & 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)
71     & )*mask_Km1
72 jmc 1.8 & *recip_rAs(i,j,bi,bj)
73 jmc 1.4
74     C Transport at interface k+1 (here wFld is already masked)
75     wBarYp=0.5*(
76     & 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)
78     & )*mask_Kp1
79 jmc 1.8 & *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 adcroft 1.2
94     C delta_Z( V ) @ interface k
95 jmc 1.4 c vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
96 jmc 1.7 vZm=(vFld(I,J,K,bi,bj)-mask_Km1*vFld(I,J,Km1,bi,bj))*rkSign
97 adcroft 1.2 c2 & *recip_dRC(K)
98 jmc 1.4 c IF (freeslip1) vZm=vZm*vmask_Km1
99     c IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.
100 adcroft 1.2
101     C delta_Z( V ) @ interface k+1
102 jmc 1.4 c vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)
103 jmc 1.7 vZp=(mask_Kp1*vFld(I,J,Kp1,bi,bj)-vFld(I,J,K,bi,bj))*rkSign
104 adcroft 1.2 c2 & *recip_dRC(Kp1)
105 jmc 1.4 c IF (freeslipK) vZp=vZp*vmask_Kp1
106     c IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.
107 adcroft 1.2
108     c1 IF (upwindShear) THEN
109     c1 wBarYZ=0.5*( wBarXm + wBarXp )
110     c1 IF (wBarYZ.GT.0.) THEN
111     c1 vZbarZ=vZp
112     c1 ELSE
113     c1 vZbarZ=vZm
114     c1 ENDIF
115     c1 ELSE
116     c1 vZbarZ=0.5*(vZm+vZp)
117     c1 ENDIF
118     c1 vShearTerm(I,J)=-wBarYZ*vZbarZ*_maskS(I,J,K,bi,bj)
119    
120     c2 vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
121     c2 & *_maskS(I,J,K,bi,bj)
122 jmc 1.6 IF (upwindShear) THEN
123     vShearTerm(I,J)=-0.5*
124     & ( (wBarYp*vZp+wBarYm*vZm)
125     & +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)
126 heimbach 1.10 & )*_recip_hFacS(i,j,k,bi,bj)
127     & * recip_drF(K)
128     c3 & * recip_rAs(i,j,bi,bj)
129 jmc 1.6 ELSE
130     vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
131 heimbach 1.10 & *_recip_hFacS(i,j,k,bi,bj)
132     & * recip_drF(K)
133     c3 & * recip_rAs(i,j,bi,bj)
134 jmc 1.6 ENDIF
135 adcroft 1.2 ENDDO
136     ENDDO
137    
138     RETURN
139     END
  ViewVC Help
Powered by ViewVC 1.1.22