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

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

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

revision 1.1 by adcroft, Wed May 2 20:35:58 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_S2(
7         U           field,
8         I           myTime, myThid )
9    C     /==========================================================\
10    C     | S/R SHAP_FILT_TRACER_S2                                  |
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 +d_yy )^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.125*(
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         &       +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
68         &            *_maskS(i,j+1,k,bi,bj)
69         &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
70         &            *_maskS(i, j ,k,bi,bj) )
71                ENDDO
72               ENDDO
73    
74               DO J=1,sNy
75                DO I=1,sNx
76                 tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
77                ENDDO
78               ENDDO
79    
80              ENDDO
81             ENDDO
82            ENDDO
83    
84           ENDDO
85    
86    C      F <-  [1-(d_xx+d_yy)^n]F
87           DO bj=myByLo(myThid),myByHi(myThid)
88            DO bi=myBxLo(myThid),myBxHi(myThid)
89             DO K=1,Nr
90              DO J=1,sNy
91               DO I=1,sNx
92                field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-tmpFld(i,j,k,bi,bj)
93               ENDDO
94              ENDDO
95             ENDDO
96            ENDDO
97           ENDDO
98    
99           _EXCH_XYZ_R8( field, myThid )
100    
101          ENDIF
102    #endif /* ALLOW_SHAP_FILT */
103    
104          RETURN
105          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22