pkg/mom_fluxform/mom_u_adv_wu.F

C $Header: $
C $Name:  $

#include "CPP_OPTIONS.h"

      SUBROUTINE MOM_U_ADV_WU(
     I        bi,bj,k,
     I        uFld,wFld,
     O        advectiveFluxWU,
     I        myThid)
      IMPLICIT NONE
C
C     Calculate advective flux in R direction for U eqn
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,Nr,nSx,nSy)
      _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      _RL advectiveFluxWU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER myThid

C     == Local variables ==
      INTEGER I,J

      IF (K.GT.Nr) THEN
C     Advective flux = 0  at K=Nr+1

      DO j=1-Oly,sNy+Oly
       DO i=1-Olx,sNx+Olx
        advectiveFluxWU(i,j) = 0.
       ENDDO
      ENDDO

      ELSEIF (K.EQ.1) THEN
C     Free-surface correction at K=1

      DO j=1-Oly,sNy+Oly
       DO i=1-Olx+1,sNx+Olx
        advectiveFluxWU(i,j) =
     &     0.5*(
     &        wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
     &       +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
     &         )*uFld(i,j,k,bi,bj)*freeSurfFac
       ENDDO
      ENDDO

      ELSE

C     - Laplacian  and bi-harmonic terms
      DO j=1-Oly,sNy+Oly
       DO i=1-Olx+1,sNx+Olx
        advectiveFluxWU(i,j) =
     &    0.25*(
     &        wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
     &       +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
     &         )*( uFld(i,j,k,bi,bj)+uFld(i,j,k-1,bi,bj) )
#ifdef OLD_ADV_BCS
     &  *_maskW(i,j,k,bi,bj) 
     &  *_maskW(i,j,k-1,bi,bj)
#endif /* OLD_ADV_BCS */
       ENDDO
      ENDDO

      ENDIF

      RETURN
      END
1	C $Header: $
2	C $Name: $
3
4	#include "CPP_OPTIONS.h"
5
6	SUBROUTINE MOM_U_ADV_WU(
7	I bi,bj,k,
8	I uFld,wFld,
9	O advectiveFluxWU,
10	I myThid)
11	IMPLICIT NONE
12	C
13	C Calculate advective flux in R direction for U eqn
14	C
15
16	C == Global variables ==
17	#include "SIZE.h"
18	#include "EEPARAMS.h"
19	#include "PARAMS.h"
20	#include "GRID.h"
21
22	C == Routine arguments ==
23	INTEGER bi,bj,k
24	_RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
25	_RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26	_RL advectiveFluxWU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
27	INTEGER myThid
28
29	C == Local variables ==
30	INTEGER I,J
31
32	IF (K.GT.Nr) THEN
33	C Advective flux = 0 at K=Nr+1
34
35	DO j=1-Oly,sNy+Oly
36	DO i=1-Olx,sNx+Olx
37	advectiveFluxWU(i,j) = 0.
38	ENDDO
39	ENDDO
40
41	ELSEIF (K.EQ.1) THEN
42	C Free-surface correction at K=1
43
44	DO j=1-Oly,sNy+Oly
45	DO i=1-Olx+1,sNx+Olx
46	advectiveFluxWU(i,j) =
47	& 0.5*(
48	& wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
49	& +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
50	& )uFld(i,j,k,bi,bj)freeSurfFac
51	ENDDO
52	ENDDO
53
54	ELSE
55
56	C - Laplacian and bi-harmonic terms
57	DO j=1-Oly,sNy+Oly
58	DO i=1-Olx+1,sNx+Olx
59	advectiveFluxWU(i,j) =
60	& 0.25*(
61	& wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
62	& +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
63	& )*( uFld(i,j,k,bi,bj)+uFld(i,j,k-1,bi,bj) )
64	#ifdef OLD_ADV_BCS
65	& *_maskW(i,j,k,bi,bj)
66	& *_maskW(i,j,k-1,bi,bj)
67	#endif /* OLD_ADV_BCS */
68	ENDDO
69	ENDDO
70
71	ENDIF
72
73	RETURN
74	END