/[MITgcm]/MITgcm/pkg/mom_fluxform/mom_u_adv_wu.F
ViewVC logotype

Diff of /MITgcm/pkg/mom_fluxform/mom_u_adv_wu.F

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

revision 1.1 by adcroft, Wed Mar 28 19:51:14 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:38 2001 UTC
# Line 0  Line 1 
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 .OR.
33         &    (k.EQ.1.AND.rigidLid) ) THEN
34    C     Advective flux = 0  at k=Nr+1 ; = 0 at k=1 if rigid-lid
35    
36          DO j=1-Oly,sNy+Oly
37           DO i=1-Olx,sNx+Olx
38            advectiveFluxWU(i,j) = 0.
39           ENDDO
40          ENDDO
41    
42          ELSEIF (k.EQ.1) THEN
43    C     (linear) Free-surface correction at k=1
44    
45          DO j=1-Oly,sNy+Oly
46           DO i=1-Olx+1,sNx+Olx
47            advectiveFluxWU(i,j) =
48         &     0.5*(
49         &        wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
50         &       +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
51         &         )*uFld(i,j,k,bi,bj)
52           ENDDO
53          ENDDO
54    
55          ELSE
56    
57    C     Vertical advection - interior ; assume uFld & wFld are masked  
58          DO j=1-Oly,sNy+Oly
59           DO i=1-Olx+1,sNx+Olx
60            advectiveFluxWU(i,j) =
61         &    0.25*(
62         &        wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
63         &       +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
64         &         )*( uFld(i,j,k,bi,bj)+uFld(i,j,k-1,bi,bj) )
65           ENDDO
66          ENDDO
67    
68          IF (.NOT. rigidLid) THEN
69    C     (linear) Free-surface correction at k>1
70            DO j=1-Oly,sNy+Oly
71             DO i=1-Olx+1,sNx+Olx
72              advectiveFluxWU(i,j) = advectiveFluxWU(i,j)
73         &     +0.25*(
74         &          wFld(i, j ,k,bi,bj)*rA(i, j ,bi,bj)*
75         &          (maskC(i,j,k,bi,bj) - maskC(i,j,k-1,bi,bj))
76         &         +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)*
77         &          (maskC(i-1,j,k,bi,bj)-maskC(i-1,j,k-1,bi,bj))
78         &           )*uFld(i,j,k,bi,bj)
79             ENDDO
80            ENDDO
81    C- endif NOT rigidLid
82          ENDIF
83    
84          ENDIF
85    
86          RETURN
87          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22