tutorial_deep_convection/code/mom_uv_smag_3d.F

C $Header: /u/gcmpack/MITgcm/verification/tutorial_deep_convection/code/mom_uv_smag_3d.F,v 1.2 2013/10/01 14:38:56 jmc Exp $
C $Name:  $

#include "MOM_COMMON_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: MOM_UV_SMAG_3D

C     !INTERFACE:
      SUBROUTINE MOM_UV_SMAG_3D(
     I        str11, str22, str12, str13, str23,
     I        viscAh3d_00, viscAh3d_12,
     I        viscAh3d_13, viscAh3d_23,
c    I        hFacZ,
     O        uDissip, vDissip,
     I        k, bi, bj, myThid )

C     !DESCRIPTION:

C     !USES:
      IMPLICIT NONE

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

C     !INPUT PARAMETERS:
      _RL str11(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL str22(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL str12(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL str13(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
      _RL str23(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
c     _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL viscAh3d_00(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL viscAh3d_12(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
      _RL viscAh3d_13(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
      _RL viscAh3d_23(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
      INTEGER k, bi, bj
      INTEGER myThid

C     !OUTPUT PARAMETERS:
      _RL uDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL vDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
CEOP

C     !LOCAL VARIABLES:
      INTEGER i,j
      INTEGER km1, kp1
      _RL maskM1, maskP1

      km1 = MAX( 1,k-1)
      kp1 = MIN(Nr,k+1)
      maskM1 = 1.
      maskP1 = 1.
      IF ( k.LE.1 )  maskM1 = 0.
      IF ( k.GE.Nr ) maskP1 = 0.

C-    Initialise output arrays:
      DO j=1-OLy,sNy+OLy
       DO i=1-OLx,sNx+OLx
         uDissip(i,j) = 0. _d 0
         vDissip(i,j) = 0. _d 0
       ENDDO
      ENDDO

C     - Laplacian and bi-harmonic terms
c     IF (harmonic) THEN

C- note: free-slip @ bottom is commented out

C-    use simple (momentum conserving) scaling
C      (but not conserving angular momentum)

       DO j=2-OLy,sNy+OLy-1
        DO i=2-OLx,sNx+OLx-1
         uDissip(i,j) = recip_rAw(i,j,bi,bj)*(
     &     ( viscAh3d_00( i , j , k )*str11( i , j , k )
     &         *dyF( i , j ,bi,bj)
     &      -viscAh3d_00(i-1, j , k )*str11(i-1, j , k )
     &         *dyF(i-1, j ,bi,bj)
     &     )
     &    +( viscAh3d_12( i ,j+1, k )*str12( i ,j+1, k )
     &         *dxV( i ,j+1,bi,bj)
     &      -viscAh3d_12( i , j , k )*str12( i , j , k )
     &         *dxV( i , j ,bi,bj)
     &     )                                 )
     &                + recip_drF( k )
     &    *( viscAh3d_13( i , j ,k+1)*str13( i , j ,k+1)
c    &         *maskW(i,j,kp1,bi,bj)*maskP1
     &      -viscAh3d_13( i , j , k )*str13( i , j , k )
c    &         *maskW(i,j,km1,bi,bj)*maskM1
     &     )*rkSign*recip_hFacW(i,j,k,bi,bj)
        ENDDO
       ENDDO

       DO j=2-OLy,sNy+OLy-1
        DO i=2-OLx,sNx+OLx-1
         vDissip(i,j) = recip_rAs(i,j,bi,bj)*(
     &     ( viscAh3d_12(i+1, j , k )*str12(i+1, j ,k)
     &         *dyU(i+1, j ,bi,bj)
     &      -viscAh3d_12( i , j , k )*str12( i , j ,k)
     &         *dyU( i , j ,bi,bj)
     &     )
     &    +( viscAh3d_00( i , j , k )*str22( i , j ,k)
     &         *dxF( i , j ,bi,bj)
     &      -viscAh3d_00( i ,j-1, k )*str22( i ,j-1,k)
     &         *dxF( i ,j-1,bi,bj)
     &     )                                )
     &                + recip_drF( k )
     &    *( viscAh3d_23( i , j ,k+1)*str23( i , j ,k+1)
c    &         *maskS(i,j,kp1,bi,bj)*maskP1
     &      -viscAh3d_23( i , j , k )*str23( i , j , k )
c    &         *maskS(i,j,km1,bi,bj)*maskM1
     &     )*rkSign*recip_hFacS(i,j,k,bi,bj)

        ENDDO
       ENDDO

c     ENDIF

c     IF (biharmonic) THEN
c      STOP 'MOM_UV_SMAG_3D: BIHARMONIC NOT ALLOWED WITH SMAG_3D'
c     ENDIF

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/verification/tutorial_deep_convection/code/mom_uv_smag_3d.F,v 1.2 2013/10/01 14:38:56 jmc Exp $
2	C $Name: $
3
4	#include "MOM_COMMON_OPTIONS.h"
5
6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	CBOP
8	C !ROUTINE: MOM_UV_SMAG_3D
9
10	C !INTERFACE:
11	SUBROUTINE MOM_UV_SMAG_3D(
12	I str11, str22, str12, str13, str23,
13	I viscAh3d_00, viscAh3d_12,
14	I viscAh3d_13, viscAh3d_23,
15	c I hFacZ,
16	O uDissip, vDissip,
17	I k, bi, bj, myThid )
18
19	C !DESCRIPTION:
20
21	C !USES:
22	IMPLICIT NONE
23
24	C == Global variables ==
25	#include "SIZE.h"
26	#include "EEPARAMS.h"
27	#include "GRID.h"
28	#include "PARAMS.h"
29
30	C !INPUT PARAMETERS:
31	_RL str11(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
32	_RL str22(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
33	_RL str12(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
34	_RL str13(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
35	_RL str23(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
36	c _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37	_RL viscAh3d_00(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
38	_RL viscAh3d_12(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
39	_RL viscAh3d_13(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
40	_RL viscAh3d_23(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1)
41	INTEGER k, bi, bj
42	INTEGER myThid
43
44	C !OUTPUT PARAMETERS:
45	_RL uDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
46	_RL vDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47	CEOP
48
49	C !LOCAL VARIABLES:
50	INTEGER i,j
51	INTEGER km1, kp1
52	_RL maskM1, maskP1
53
54	km1 = MAX( 1,k-1)
55	kp1 = MIN(Nr,k+1)
56	maskM1 = 1.
57	maskP1 = 1.
58	IF ( k.LE.1 ) maskM1 = 0.
59	IF ( k.GE.Nr ) maskP1 = 0.
60
61	C- Initialise output arrays:
62	DO j=1-OLy,sNy+OLy
63	DO i=1-OLx,sNx+OLx
64	uDissip(i,j) = 0. _d 0
65	vDissip(i,j) = 0. _d 0
66	ENDDO
67	ENDDO
68
69	C - Laplacian and bi-harmonic terms
70	c IF (harmonic) THEN
71
72	C- note: free-slip @ bottom is commented out
73
74	C- use simple (momentum conserving) scaling
75	C (but not conserving angular momentum)
76
77	DO j=2-OLy,sNy+OLy-1
78	DO i=2-OLx,sNx+OLx-1
79	uDissip(i,j) = recip_rAw(i,j,bi,bj)*(
80	& ( viscAh3d_00( i , j , k )*str11( i , j , k )
81	& *dyF( i , j ,bi,bj)
82	& -viscAh3d_00(i-1, j , k )*str11(i-1, j , k )
83	& *dyF(i-1, j ,bi,bj)
84	& )
85	& +( viscAh3d_12( i ,j+1, k )*str12( i ,j+1, k )
86	& *dxV( i ,j+1,bi,bj)
87	& -viscAh3d_12( i , j , k )*str12( i , j , k )
88	& *dxV( i , j ,bi,bj)
89	& ) )
90	& + recip_drF( k )
91	& ( viscAh3d_13( i , j ,k+1)str13( i , j ,k+1)
92	c & maskW(i,j,kp1,bi,bj)maskP1
93	& -viscAh3d_13( i , j , k )*str13( i , j , k )
94	c & maskW(i,j,km1,bi,bj)maskM1
95	& )rkSignrecip_hFacW(i,j,k,bi,bj)
96	ENDDO
97	ENDDO
98
99	DO j=2-OLy,sNy+OLy-1
100	DO i=2-OLx,sNx+OLx-1
101	vDissip(i,j) = recip_rAs(i,j,bi,bj)*(
102	& ( viscAh3d_12(i+1, j , k )*str12(i+1, j ,k)
103	& *dyU(i+1, j ,bi,bj)
104	& -viscAh3d_12( i , j , k )*str12( i , j ,k)
105	& *dyU( i , j ,bi,bj)
106	& )
107	& +( viscAh3d_00( i , j , k )*str22( i , j ,k)
108	& *dxF( i , j ,bi,bj)
109	& -viscAh3d_00( i ,j-1, k )*str22( i ,j-1,k)
110	& *dxF( i ,j-1,bi,bj)
111	& ) )
112	& + recip_drF( k )
113	& ( viscAh3d_23( i , j ,k+1)str23( i , j ,k+1)
114	c & maskS(i,j,kp1,bi,bj)maskP1
115	& -viscAh3d_23( i , j , k )*str23( i , j , k )
116	c & maskS(i,j,km1,bi,bj)maskM1
117	& )rkSignrecip_hFacS(i,j,k,bi,bj)
118
119	ENDDO
120	ENDDO
121
122	c ENDIF
123
124	c IF (biharmonic) THEN
125	c STOP 'MOM_UV_SMAG_3D: BIHARMONIC NOT ALLOWED WITH SMAG_3D'
126	c ENDIF
127
128	RETURN
129	END