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

Diff of /MITgcm/pkg/shap_filt/shap_filt_v.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_V( vVel,bi,bj,K,myCurrentTime,myThid )
6    C     /==========================================================\
7    C     | S/R SHAP_FILT_V                                          |
8    C     | Applies Shapiro filter to V 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 vVel(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    C     Create temporary Zeta mask (accounting for thin walls)
34          DO J=1-OLy+1,sNy+OLy
35           DO I=1-OLx,sNx+OLx
36            maskZ(i,j) = _maskW(i,j-1,k,bi,bj)
37         &              *_maskW(i, j ,k,bi,bj)
38           ENDDO
39          ENDDO
40    
41          DO J=1-OLy,sNy+OLy
42           DO I=1-OLx,sNx+OLx
43            tmpFldX(i,j,1) = vVel(i,j,k,bi,bj)
44         &                   *_maskS(i,j,k,bi,bj)
45           ENDDO
46          ENDDO
47    
48    C     Extract small-scale noise from tmpFldX (delta_ii^n)
49          DO N=1,nShap
50           N1=1+mod(N+1,2)
51           N2=1+mod( N ,2)
52           DO J=1-OLy+1,sNy+OLy
53            DO I=1-OLx+1,sNx+OLx-1
54             tmpFldX(i,j,N2) = -0.25*(
55         &    (tmpFldX(i+1,j,N1)-tmpFldX( i ,j,N1))*maskZ(i+1,j)
56         &   -(tmpFldX( i ,j,N1)-tmpFldX(i-1,j,N1))*maskZ( i ,j)
57    #ifdef NO_SLIP_SHAP
58         &   -2.*(2.-maskZ(i,j)-maskZ(i+1,j))*tmpFldX(i,j,N1)
59    #endif
60         &         )*_maskS(i,j,k,bi,bj)
61            ENDDO
62           ENDDO
63          ENDDO
64    
65    #ifdef SEQUENTIAL_2D_SHAP
66          DO J=1-OLy,sNy+OLy
67           DO I=1-OLx,sNx+OLx
68            tmpFldX(i,j,N2) = vVel(i,j,k,bi,bj) - tmpFldX(i,j,N2)
69            tmpFldY(i,j,1) = tmpFldX(i,j,N2)
70           ENDDO
71          ENDDO
72    #else
73          DO J=1-OLy,sNy+OLy
74           DO I=1-OLx,sNx+OLx
75            tmpFldY(i,j,1) = vVel(i,j,k,bi,bj)
76         &                   *_maskS(i,j,k,bi,bj)
77           ENDDO
78          ENDDO
79    #endif /* SEQUENTIAL_2D_SHAP */
80    
81    C     Extract small-scale noise from tmpFldY (delta_jj^n)
82          DO N=1,nShap
83           N1=1+mod(N+1,2)
84           N2=1+mod( N ,2)
85           DO J=1-OLy+1,sNy+OLy-1
86            DO I=1-OLx,sNx+OLx
87             tmpFldY(i,j,N2) = -0.25*(
88         &          tmpFldY(i,j-1,N1) + tmpFldY(i,j+1,N1)
89         &             - 2.*tmpFldY(i,j,N1)
90         &            )*_maskS(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            vVel(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            vVel(i,j,k,bi,bj) = vVel(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