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

Contents 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 - (show 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 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 C $Name: $
3
4 #include "MOM_VECINV_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
34 LOGICAL rAdvAreaWeight
35 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 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)
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 DO J=2-Oly,sNy+Oly
57 DO I=1-Olx,sNx+Olx
58
59 c vmask_K=_maskS(i,j,k,bi,bj)
60
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 IF ( rAdvAreaWeight ) THEN
67 C Transport at interface k : Area weighted average
68 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 & *recip_rAs(i,j,bi,bj)
73
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 & *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
95 c vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
96 vZm=(vFld(I,J,K,bi,bj)-mask_Km1*vFld(I,J,Km1,bi,bj))*rkSign
97 c2 & *recip_dRC(K)
98 c IF (freeslip1) vZm=vZm*vmask_Km1
99 c IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.
100
101 C delta_Z( V ) @ interface k+1
102 c vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)
103 vZp=(mask_Kp1*vFld(I,J,Kp1,bi,bj)-vFld(I,J,K,bi,bj))*rkSign
104 c2 & *recip_dRC(Kp1)
105 c IF (freeslipK) vZp=vZp*vmask_Kp1
106 c IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.
107
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 IF (upwindShear) THEN
123 vShearTerm(I,J)=-0.5*
124 & ( (wBarYp*vZp+wBarYm*vZm)
125 & +(ABS(wBarYp)*vZp-ABS(wBarYm)*vZm)
126 & )*_recip_hFacS(i,j,k,bi,bj)
127 & * recip_drF(K)
128 c3 & * recip_rAs(i,j,bi,bj)
129 ELSE
130 vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
131 & *_recip_hFacS(i,j,k,bi,bj)
132 & * recip_drF(K)
133 c3 & * recip_rAs(i,j,bi,bj)
134 ENDIF
135 ENDDO
136 ENDDO
137
138 RETURN
139 END
  ViewVC Help
Powered by ViewVC 1.1.22