/[MITgcm]/MITgcm/pkg/mom_common/mom_u_bottomdrag.F
ViewVC logotype

Contents of /MITgcm/pkg/mom_common/mom_u_bottomdrag.F

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


Revision 1.11 - (show annotations) (download)
Thu Jul 19 11:22:24 2012 UTC (11 years, 11 months ago) by mlosch
Branch: MAIN
Changes since 1.10: +2 -2 lines
replace KE.ne.0 with KE.gt.0 to avoid sqrt of negative numbers (KE) that
can occur with aggressive optimization

1 C $Header: /u/gcmpack/MITgcm/pkg/mom_common/mom_u_bottomdrag.F,v 1.10 2012/04/26 21:23:20 heimbach Exp $
2 C $Name: $
3
4 #include "MOM_COMMON_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: MOM_U_BOTTOMDRAG
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE MOM_U_BOTTOMDRAG(
11 I bi,bj,k,
12 I uFld, KE, KappaRU,
13 O uDragTerms,
14 I myThid)
15
16 C !DESCRIPTION:
17 C Calculates the drag due to friction and the no-slip condition at bottom:
18 C \begin{equation*}
19 C G^u_{drag} = - \frac{1}{\Delta r_f} ( r_b + C_D |v| + \frac{2}{\Delta r_c} ) u
20 C \end{equation*}
21
22 C !USES: ===============================================================
23 IMPLICIT NONE
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #ifdef ALLOW_BOTTOMDRAG_CONTROL
29 # include "DYNVARS.h"
30 #endif
31
32 C !INPUT PARAMETERS: ===================================================
33 C bi,bj :: tile indices
34 C k :: vertical level
35 C uFld :: zonal flow
36 C KE :: Kinetic energy
37 C KappaRU :: vertical viscosity
38 C myThid :: thread number
39 INTEGER bi,bj,k
40 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
41 _RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42 _RL KappaRU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
43 INTEGER myThid
44
45 C !OUTPUT PARAMETERS: ==================================================
46 C uDragTerms :: drag term
47 _RL uDragTerms(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48
49 C !LOCAL VARIABLES: ====================================================
50 C i,j :: loop indices
51 C Kp1 :: =k+1 for k<Nr, =Nr for k>=Nr
52 INTEGER i,j,kDown,kDownC,kBottom
53 _RL viscFac, dragFac
54 _RL rdrckp1, maskDown
55 CEOP
56
57 C- No-slip BCs impose a drag at bottom
58 IF ( usingZCoords ) THEN
59 kBottom = Nr
60 kDown = min(k+1,kBottom)
61 kDownC = kDown
62 c dragFac = mass2rUnit*rhoConst
63 c dragFac = wUnit2rVel(k+1)
64 dragFac = 1. _d 0
65 ELSE
66 kBottom = 1
67 kDown = max(k-1,kBottom)
68 kDownC = k
69 dragFac = mass2rUnit*rhoConst
70 c dragFac = wUnit2rVel(k)
71 ENDIF
72 rdrckp1=recip_drC(kDownC)
73 IF (k.EQ.kBottom) rdrckp1=recip_drF(k)
74 viscFac=0.
75 IF (no_slip_bottom) viscFac=1.
76 DO j=1-Oly,sNy+Oly-1
77 DO i=1-Olx+1,sNx+Olx-1
78 maskDown=_maskW(i,j,kDown,bi,bj)
79 IF (k.EQ.kBottom) maskDown=0.
80 uDragTerms(i,j)=
81 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
82 & *(
83 & 2.*KappaRU(i,j,kDownC)*rdrckp1*viscFac
84 #ifdef ALLOW_BOTTOMDRAG_CONTROL
85 & + bottomdragfld(i,j,bi,bj)*dragFac
86 #endif
87 & + bottomDragLinear*dragFac
88 & )*(1.-maskDown)*uFld(i,j)
89 IF ( (KE(i,j)+KE(i-1,j)) .GT. 0. ) THEN
90 uDragTerms(i,j)=uDragTerms(i,j)
91 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
92 & *bottomDragQuadratic*SQRT(KE(i,j)+KE(i-1,j))*dragFac
93 & *(1.-maskDown)*uFld(i,j)
94 ENDIF
95 ENDDO
96 ENDDO
97
98 #ifdef ALLOW_DIAGNOSTICS
99 IF (useDiagnostics) THEN
100 CALL DIAGNOSTICS_FILL(uDragTerms,'UBotDrag',k,1,2,bi,bj,myThid)
101 ENDIF
102 #endif /* ALLOW_DIAGNOSTICS */
103
104 RETURN
105 END

  ViewVC Help
Powered by ViewVC 1.1.22