/[MITgcm]/MITgcm/pkg/shap_filt/shap_filt_u.F
ViewVC logotype

Diff of /MITgcm/pkg/shap_filt/shap_filt_u.F

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

revision 1.1 by adcroft, Tue Jan 23 15:58:59 2001 UTC revision 1.2 by adcroft, Fri Feb 2 21:36:30 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "SHAP_FILT_OPTIONS.h"
4    
5          SUBROUTINE SHAP_FILT_U(uVel,bi,bj,K,myCurrentTime,myThid)
6    C     /==========================================================\
7    C     | S/R SHAP_FILT_U                                          |
8    C     | Applies Shapiro filter to U field over one XY slice      |
9    C     | of one tile at a time.                                   |
10    C     \==========================================================/
11          IMPLICIT NONE
12    
13    C     == Global variables ===
14    #include "SIZE.h"
15    #include "EEPARAMS.h"
16    #include "PARAMS.h"
17    #include "GRID.h"
18    
19    C     == Routine arguments
20          _RL uVel(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
21          INTEGER myThid
22          _RL     myCurrentTime
23          INTEGER bi, bj, K
24    
25    #ifdef ALLOW_SHAP_FILT
26    
27    C     == Local variables ==
28          _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
29          _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
30          _RS maskZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
31          INTEGER I,J,N,N1,N2
32    
33          DO J=1-OLy,sNy+OLy
34           DO I=1-OLx,sNx+OLx
35            tmpFldX(i,j,1) = uVel(i,j,k,bi,bj)
36         &                   *_maskW(i,j,k,bi,bj)
37           ENDDO
38          ENDDO
39    
40    C     Extract small-scale noise from tmpFldX (delta_ii^n)
41          DO N=1,nShap
42           N1=1+mod(N+1,2)
43           N2=1+mod( N ,2)
44           DO J=1-OLy,sNy+OLy
45            DO I=1-OLx+1,sNx+OLx-1
46             tmpFldX(i,j,N2) = -0.25*(
47         &          tmpFldX(i-1,j,N1) + tmpFldX(i+1,j,N1)
48         &             - 2.*tmpFldX(i,j,N1)
49         &            )*_maskW(i,j,k,bi,bj)
50            ENDDO
51           ENDDO
52          ENDDO
53    
54    C     Create temporary Zeta mask (accounting for thin walls)
55          DO J=1-OLy,sNy+OLy
56           DO I=1-OLx+1,sNx+OLx
57            maskZ(i,j) = _maskS(i-1,j,k,bi,bj)
58         &              *_maskS( i ,j,k,bi,bj)
59           ENDDO
60          ENDDO
61    
62    #ifdef SEQUENTIAL_2D_SHAP
63          DO J=1-OLy,sNy+OLy
64           DO I=1-OLx,sNx+OLx
65            tmpFldX(i,j,N2) = uVel(i,j,k,bi,bj) - tmpFldX(i,j,N2)
66            tmpFldY(i,j,1) = tmpFldX(i,j,N2)
67           ENDDO
68          ENDDO
69    #else
70          DO J=1-OLy,sNy+OLy
71           DO I=1-OLx,sNx+OLx
72            tmpFldY(i,j,1) = uVel(i,j,k,bi,bj)
73         &                   *_maskW(i,j,k,bi,bj)
74           ENDDO
75          ENDDO
76    #endif /* SEQUENTIAL_2D_SHAP */
77    
78    C     Extract small-scale noise from tmpFldY (delta_jj^n)
79          DO N=1,nShap
80           N1=1+mod(N+1,2)
81           N2=1+mod( N ,2)
82           DO J=1-OLy+1,sNy+OLy-1
83            DO I=1-OLx+1,sNx+OLx
84             tmpFldY(i,j,N2) = -0.25*(
85         &    (tmpFldY(i,j+1,N1)-tmpFldY(i, j ,N1))*maskZ(i,j+1)
86         &   -(tmpFldY(i, j ,N1)-tmpFldY(i,j-1,N1))*maskZ(i, j )
87    #ifdef NO_SLIP_SHAP
88         &   -2.*(2.-maskZ(i,j)-maskZ(i,j+1))*tmpFldY(i,j,N1)
89    #endif
90         &         )*_maskW(i,j,k,bi,bj)
91            ENDDO
92           ENDDO
93          ENDDO
94    
95    C     Subtract small-scale noise from field
96    #ifdef SEQUENTIAL_2D_SHAP
97          DO J=1-OLy,sNy+OLy
98           DO I=1-OLx,sNx+OLx
99            uVel(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
100           ENDDO
101          ENDDO
102    #else
103          DO J=1-OLy,sNy+OLy
104           DO I=1-OLx,sNx+OLx
105            uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)
106         &    -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
107           ENDDO
108          ENDDO
109    #endif /* SEQUENTIAL_2D_SHAP */
110    
111    #endif /* ALLOW_SHAP_FILT */
112    
113          RETURN
114          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22