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

Diff of /MITgcm/pkg/shap_filt/shap_filt_tracerold.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_TRACEROLD(
6         U           field,
7         I           bi, bj, K, myCurrentTime, myThid )
8    C     /==========================================================\
9    C     | S/R SHAP_FILT_TRACER                                     |
10    C     | Applies Shapiro filter to tracer field over one XY slice |
11    C     | of one tile at a time.                                   |
12    C     \==========================================================/
13          IMPLICIT NONE
14    
15    C     == Global variables ===
16    #include "SIZE.h"
17    #include "EEPARAMS.h"
18    #include "PARAMS.h"
19    #include "GRID.h"
20    
21    C     == Routine arguments
22          INTEGER myThid
23          _RL     myCurrentTime
24          INTEGER bi, bj, K
25          _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26    
27    #ifdef ALLOW_SHAP_FILT
28    
29    C     == Local variables ==
30          _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
31          _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
32          INTEGER I,J,N,N1,N2
33    
34          DO J=1-OLy,sNy+OLy
35           DO I=1-OLx,sNx+OLx
36            tmpFldX(i,j,1) = field(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 ,j,N1) )
48         &        *_maskW(i+1,j,k,bi,bj)
49         &   -( tmpFldX( i ,j,N1)-tmpFldX(i-1,j,N1) )
50         &        *_maskW(i,j,k,bi,bj) )
51            ENDDO
52           ENDDO
53          ENDDO
54    
55    #ifdef SEQUENTIAL_2D_SHAP
56          DO J=1-OLy,sNy+OLy
57           DO I=1-OLx,sNx+OLx
58            tmpFldX(i,j,N2) = field(i,j,k,bi,bj) - tmpFldX(i,j,N2)
59            tmpFldY(i,j,1) = tmpFldX(i,j,N2)
60           ENDDO
61          ENDDO
62    #else
63          DO J=1-OLy,sNy+OLy
64           DO I=1-OLx,sNx+OLx
65            tmpFldY(i,j,1) = field(i,j,k,bi,bj)
66           ENDDO
67          ENDDO
68    #endif /* SEQUENTIAL_2D_SHAP */
69    
70    C     Extract small-scale noise from tmpFldY (delta_jj^n)
71          DO N=1,nShap
72           N1=1+mod(N+1,2)
73           N2=1+mod( N ,2)
74           DO J=1-OLy+1,sNy+OLy-1
75            DO I=1-OLx,sNx+OLx
76             tmpFldY(i,j,N2) = -0.25*(
77         &    ( tmpFldY(i,j+1,N1)-tmpFldY(i, j ,N1) )
78         &        *_maskS(i,j+1,k,bi,bj)
79         &   -( tmpFldY(i, j ,N1)-tmpFldY(i,j-1,N1) )
80         &        *_maskS(i,j,k,bi,bj) )
81            ENDDO
82           ENDDO
83          ENDDO
84    
85    C     Subtract small-scale noise from field
86    #ifdef SEQUENTIAL_2D_SHAP
87          DO J=1-OLy,sNy+OLy
88           DO I=1-OLx,sNx+OLx
89            field(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
90           ENDDO
91          ENDDO
92    #else
93          DO J=1-OLy,sNy+OLy
94           DO I=1-OLx,sNx+OLx
95            field(i,j,k,bi,bj) = field(i,j,k,bi,bj)
96         &    -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
97           ENDDO
98          ENDDO
99    #endif /* SEQUENTIAL_2D_SHAP */
100    
101    #endif /* ALLOW_SHAP_FILT */
102    
103          RETURN
104          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22