pkg/mom_vecinv/mom_u_bottomdrag.F

C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_u_bottomdrag.F,v 1.3 2001/07/13 13:49:05 heimbach Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

      SUBROUTINE MOM_U_BOTTOMDRAG(
     I        bi,bj,k,
     I        uFld, KE, KappaRU,
     O        uDragTerms,
     I        myThid)
      IMPLICIT NONE
C
C     Calculate bottom drag terms for U eqn
C       - is not vector invariant ...
C

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"

C     == Routine arguments ==
      INTEGER bi,bj,k
      _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL KappaRU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL uDragTerms(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL viscFac
      INTEGER myThid

C     == Local variables ==
      INTEGER I,J,Kp1
      _RL rdrckp1,maskDown

C-  No-slip BCs impose a drag at bottom
      Kp1=min(k+1,Nr)
      rdrckp1=recip_drC(kp1)
      IF (k.EQ.Nr) rdrckp1=recip_drF(k)
      viscFac=1.
      IF (.NOT. no_slip_bottom) viscFac=0.
      DO j=1-Oly,sNy+Oly-1
       DO i=1-Olx+1,sNx+Olx-1
        maskDown=_maskW(i,j,kp1,bi,bj)
        IF (k.EQ.Nr) maskDown=0.
        uDragTerms(i,j)=
     &   -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
     &   *( 
     &      2.*KappaRU(i,j,kp1)*rkFac*rdrckp1*viscFac
     &     + bottomDragLinear
     &    )*(1.-maskDown)*uFld(i,j)
        IF ( (KE(i,j)+KE(i-1,j)) .NE. 0. ) THEN
         uDragTerms(i,j)=uDragTerms(i,j)
     &    -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
     &    *bottomDragQuadratic*sqrt(KE(i,j)+KE(i-1,j))
     &    *(1.-maskDown)*uFld(i,j)
        ENDIF
       ENDDO
      ENDDO

      RETURN
      END
1	heimbach	1.4	C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_u_bottomdrag.F,v 1.3 2001/07/13 13:49:05 heimbach Exp $
2			C $Name: $
3	adcroft	1.2
4			#include "CPP_OPTIONS.h"
5
6			SUBROUTINE MOM_U_BOTTOMDRAG(
7			I bi,bj,k,
8			I uFld, KE, KappaRU,
9			O uDragTerms,
10			I myThid)
11			IMPLICIT NONE
12			C
13			C Calculate bottom drag terms for U eqn
14			C - is not vector invariant ...
15			C
16
17			C == Global variables ==
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20			#include "PARAMS.h"
21			#include "GRID.h"
22
23			C == Routine arguments ==
24			INTEGER bi,bj,k
25			_RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
26			_RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
27			_RL KappaRU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
28			_RL uDragTerms(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
29			_RL viscFac
30			INTEGER myThid
31
32			C == Local variables ==
33			INTEGER I,J,Kp1
34			_RL rdrckp1,maskDown
35
36			C- No-slip BCs impose a drag at bottom
37			Kp1=min(k+1,Nr)
38			rdrckp1=recip_drC(kp1)
39			IF (k.EQ.Nr) rdrckp1=recip_drF(k)
40			viscFac=1.
41			IF (.NOT. no_slip_bottom) viscFac=0.
42			DO j=1-Oly,sNy+Oly-1
43			DO i=1-Olx+1,sNx+Olx-1
44			maskDown=_maskW(i,j,kp1,bi,bj)
45			IF (k.EQ.Nr) maskDown=0.
46			uDragTerms(i,j)=
47			& -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
48			& *(
49			& 2.KappaRU(i,j,kp1)rkFacrdrckp1viscFac
50			& + bottomDragLinear
51			& )(1.-maskDown)uFld(i,j)
52	heimbach	1.3	IF ( (KE(i,j)+KE(i-1,j)) .NE. 0. ) THEN
53			uDragTerms(i,j)=uDragTerms(i,j)
54			& -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
55			& bottomDragQuadraticsqrt(KE(i,j)+KE(i-1,j))
56			& (1.-maskDown)uFld(i,j)
57			ENDIF
58	adcroft	1.2	ENDDO
59			ENDDO
60
61			RETURN
62			END