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

Diff of /MITgcm/pkg/shap_filt/shap_filt_tracer_s1.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_S1(
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          _RL tmpScal
35    
36          IF (nShapT.gt.0) THEN
37    
38            DO bj=myByLo(myThid),myByHi(myThid)
39             DO bi=myBxLo(myThid),myBxHi(myThid)
40              DO K=1,Nr
41               DO J=1,sNy
42                DO I=1,sNx
43                 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
44                ENDDO
45               ENDDO
46              ENDDO
47             ENDDO
48            ENDDO
49    
50    
51    C      d_xx^n tmpFld
52    
53           DO N=1,nShapT
54    
55            _EXCH_XYZ_R8( tmpFld, myThid )
56    
57            DO bj=myByLo(myThid),myByHi(myThid)
58             DO bi=myBxLo(myThid),myBxHi(myThid)
59              DO K=1,Nr
60    
61               DO J=1,sNy
62                DO I=1,sNx
63                 tmpGrd(i,j) = -0.25*(
64         &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
65         &            *_maskW(i+1,j,k,bi,bj)
66         &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
67         &            *_maskW(i,j,k,bi,bj) )
68                ENDDO
69               ENDDO
70    
71               DO J=1,sNy
72                DO I=1,sNx
73                 tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
74                ENDDO
75               ENDDO
76    
77              ENDDO
78             ENDDO
79            ENDDO
80    
81           ENDDO
82    
83    C      F <-  [1-d_xx^n]F
84           DO bj=myByLo(myThid),myByHi(myThid)
85            DO bi=myBxLo(myThid),myBxHi(myThid)
86             DO K=1,Nr
87              DO J=1,sNy
88               DO I=1,sNx
89                tmpScal=tmpFld(i,j,k,bi,bj)
90                tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
91                field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal
92               ENDDO
93              ENDDO
94             ENDDO
95            ENDDO
96           ENDDO
97    
98    
99    C      d_yy^n tmpFld
100    
101           DO N=1,nShapT
102    
103            _EXCH_XYZ_R8( tmpFld, myThid )
104    
105            DO bj=myByLo(myThid),myByHi(myThid)
106             DO bi=myBxLo(myThid),myBxHi(myThid)
107              DO K=1,Nr
108    
109               DO J=1,sNy
110                DO I=1,sNx
111                 tmpGrd(i,j) = -0.25*(
112         &        ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
113         &            *_maskS(i,j+1,k,bi,bj)
114         &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
115         &            *_maskS(i,j,k,bi,bj) )
116                ENDDO
117               ENDDO
118    
119               DO J=1,sNy
120                DO I=1,sNx
121                 tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
122                ENDDO
123               ENDDO
124    
125              ENDDO
126             ENDDO
127            ENDDO
128    
129           ENDDO
130    
131    C      F <-  [1-d_yy^n]F
132           DO bj=myByLo(myThid),myByHi(myThid)
133            DO bi=myBxLo(myThid),myBxHi(myThid)
134             DO K=1,Nr
135              DO J=1,sNy
136               DO I=1,sNx
137                tmpScal=tmpFld(i,j,k,bi,bj)
138                field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal
139               ENDDO
140              ENDDO
141             ENDDO
142            ENDDO
143           ENDDO
144    
145           _EXCH_XYZ_R8( field, myThid )
146    
147          ENDIF
148    #endif /* ALLOW_SHAP_FILT */
149    
150          RETURN
151          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22