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

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

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

revision 1.1 by adcroft, Mon May 7 18:40:02 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:40 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "SHAP_FILT_OPTIONS.h"
5    
6          SUBROUTINE SHAP_FILT_TRACER_S4(
7         U           field,
8         I           myTime, myThid )
9    C     /==========================================================\
10    C     | S/R SHAP_FILT_TRACER                                     |
11    C     | Applies Shapiro filter to tracer field over one XY slice |
12    C     | of one tile at a time.                                   |
13    C     \==========================================================/
14          IMPLICIT NONE
15    
16    C     == Global variables ===
17    #include "SIZE.h"
18    #include "EEPARAMS.h"
19    #include "PARAMS.h"
20    #include "GRID.h"
21    #include "SHAP_FILT.h"
22    #include "SHAP_FILT_TRACER.h"
23    
24    C     == Routine arguments
25          _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26          _RL     myTime
27          INTEGER myThid
28    
29    #ifdef ALLOW_SHAP_FILT
30    
31    C     == Local variables ==
32          INTEGER bi,bj,K,I,J,N
33          _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
34    
35          IF (nShapT.gt.0) THEN
36    
37            DO bj=myByLo(myThid),myByHi(myThid)
38             DO bi=myBxLo(myThid),myBxHi(myThid)
39              DO K=1,Nr
40               DO J=1,sNy
41                DO I=1,sNx
42                 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
43                ENDDO
44               ENDDO
45              ENDDO
46             ENDDO
47            ENDDO
48    
49    
50    C      d_xx^n tmpFld
51    
52           DO N=1,nShapT
53    
54            _EXCH_XYZ_R8( tmpFld, myThid )
55    
56            DO bj=myByLo(myThid),myByHi(myThid)
57             DO bi=myBxLo(myThid),myBxHi(myThid)
58              DO K=1,Nr
59    
60               DO J=1,sNy
61                DO I=1,sNx
62                 tmpGrd(i,j) = -0.25*(
63         &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
64         &            *_maskW(i+1,j,k,bi,bj)
65         &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
66         &            *_maskW(i,j,k,bi,bj) )
67                ENDDO
68               ENDDO
69    
70               DO J=1,sNy
71                DO I=1,sNx
72                 tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
73                ENDDO
74               ENDDO
75    
76              ENDDO
77             ENDDO
78            ENDDO
79    
80           ENDDO
81    
82    C      F <-  [1-d_xx^n]F
83           DO bj=myByLo(myThid),myByHi(myThid)
84            DO bi=myBxLo(myThid),myBxHi(myThid)
85             DO K=1,Nr
86              DO J=1,sNy
87               DO I=1,sNx
88                tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)-tmpFld(i,j,k,bi,bj)
89                field(i,j,k,bi,bj)=tmpFld(i,j,k,bi,bj)
90               ENDDO
91              ENDDO
92             ENDDO
93            ENDDO
94           ENDDO
95    
96    
97    C      d_yy^n tmpFld
98    
99           DO N=1,nShapT
100    
101            _EXCH_XYZ_R8( tmpFld, myThid )
102    
103            DO bj=myByLo(myThid),myByHi(myThid)
104             DO bi=myBxLo(myThid),myBxHi(myThid)
105              DO K=1,Nr
106    
107               DO J=1,sNy
108                DO I=1,sNx
109                 tmpGrd(i,j) = -0.25*(
110         &        ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
111         &            *_maskS(i,j+1,k,bi,bj)
112         &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
113         &            *_maskS(i,j,k,bi,bj) )
114                ENDDO
115               ENDDO
116    
117               DO J=1,sNy
118                DO I=1,sNx
119                 tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
120                ENDDO
121               ENDDO
122    
123              ENDDO
124             ENDDO
125            ENDDO
126    
127           ENDDO
128    
129    C      F <-  [1-d_yy^n]F
130           DO bj=myByLo(myThid),myByHi(myThid)
131            DO bi=myBxLo(myThid),myBxHi(myThid)
132             DO K=1,Nr
133              DO J=1,sNy
134               DO I=1,sNx
135                field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-tmpFld(i,j,k,bi,bj)
136               ENDDO
137              ENDDO
138             ENDDO
139            ENDDO
140           ENDDO
141    
142           _EXCH_XYZ_R8( field, myThid )
143    
144          ENDIF
145    #endif /* ALLOW_SHAP_FILT */
146    
147          RETURN
148          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22