/[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.2 by adcroft, Tue May 29 14:01:40 2001 UTC revision 1.3 by jmc, Fri Jun 15 15:14:56 2001 UTC
# Line 29  C     == Routine arguments Line 29  C     == Routine arguments
29  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
30    
31  C     == Local variables ==  C     == Local variables ==
32          INTEGER nShapComput
33        INTEGER bi,bj,K,I,J,N        INTEGER bi,bj,K,I,J,N
34        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35    
36        IF (nShapT.gt.0) THEN        IF (nShapT.GT.0) THEN
37    C-------
38    C  Apply computational filter ^(nShap-nShapPhys) without grid factor
39    C  then apply Physical filter ^nShapPhys  with grid factors
40    C-------
41            nShapComput = nShapT - nShapTrPhys
42    
43          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
44           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
45            DO K=1,Nr            DO K=1,Nr
46             DO J=1,sNy             DO J=1-Oly,sNy+Oly
47              DO I=1,sNx              DO I=1-Olx,sNx+Olx
48               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
49              ENDDO              ENDDO
50             ENDDO             ENDDO
# Line 49  C     == Local variables == Line 55  C     == Local variables ==
55    
56  C      ( d_xx +d_yy )^n tmpFld  C      ( d_xx +d_yy )^n tmpFld
57    
58         DO N=1,nShapT  C-- Computational Filter
59           DO N=1,nShapComput
60    
61          _EXCH_XYZ_R8( tmpFld, myThid )          _EXCH_XYZ_R8( tmpFld, myThid )
62    
63          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
64           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
65            DO K=1,Nr            DO K=1,Nr
66    
67             DO J=1,sNy             DO J=1,sNy
68              DO I=1,sNx              DO I=1,sNx
69               tmpGrd(i,j) = -0.125*(               tmpGrd(i,j) =
70       &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )       &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
71       &            *_maskW(i+1,j,k,bi,bj)       &            *_maskW(i+1,j,k,bi,bj)
72       &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )       &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
73       &            *_maskW( i ,j,k,bi,bj)       &            *_maskW( i ,j,k,bi,bj)
74       &       +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )       &       +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
75       &            *_maskS(i,j+1,k,bi,bj)       &            *_maskS(i,j+1,k,bi,bj)
76       &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )       &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
77       &            *_maskS(i, j ,k,bi,bj) )       &            *_maskS(i, j ,k,bi,bj)
78              ENDDO              ENDDO
79             ENDDO             ENDDO
80    
81             DO J=1,sNy             DO J=1,sNy
82              DO I=1,sNx              DO I=1,sNx
83               tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)               tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
84              ENDDO              ENDDO
85             ENDDO             ENDDO
86    
87            ENDDO            ENDDO
88           ENDDO           ENDDO
89          ENDDO          ENDDO
90    C      end loop N=1,nShapComput
91           ENDDO
92    
93           DO N=1,nShapTrPhys
94    C-- Physical space Filter
95    
96            _EXCH_XYZ_R8( tmpFld, myThid )
97    
98            DO bj=myByLo(myThid),myByHi(myThid)
99             DO bi=myBxLo(myThid),myBxHi(myThid)
100              DO K=1,Nr
101    
102               DO J=1,sNy
103                DO I=1,sNx
104                 tmpGrd(i,j) =
105         &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
106         &            *_hFacW(i+1,j,k,bi,bj)
107         &            *DYG(i+1,j,bi,bj)
108         &            *recip_DXC(i+1,j,bi,bj)
109         &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
110         &            *_hFacW( i ,j,k,bi,bj)
111         &            *DYG( i ,j,bi,bj)
112         &            *recip_DXC( i ,j,bi,bj)
113         &       +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
114         &            *_hFacS(i,j+1,k,bi,bj)
115         &            *DXG(i,j+1,bi,bj)
116         &            *recip_DYC(i,j+1,bi,bj)
117         &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
118         &            *_hFacS(i, j ,k,bi,bj)
119         &            *DXG(i, j ,bi,bj)
120         &            *recip_DYC(i, j ,bi,bj)
121                ENDDO
122               ENDDO
123    
124               IF (Shap_TrLength.EQ.0.) THEN
125                DO J=1,sNy
126                 DO I=1,sNx
127                  tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
128         &           *recip_hFacC(i,j,k,bi,bj)
129                 ENDDO
130                ENDDO
131               ELSE
132                DO J=1,sNy
133                 DO I=1,sNx
134                  tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
135         &           *recip_hFacC(i,j,k,bi,bj)*recip_rA(i,j,bi,bj)
136         &           *Shap_TrLength*Shap_TrLength
137                 ENDDO
138                ENDDO
139               ENDIF
140    
141              ENDDO
142             ENDDO
143            ENDDO
144    C      end loop N=1,nShapTrPhys
145         ENDDO         ENDDO
146    
147  C      F <-  [1-(d_xx+d_yy)^n]F  C      F <-  [1-(d_xx+d_yy)^n]F
# Line 89  C      F <-  [1-(d_xx+d_yy)^n]F Line 150  C      F <-  [1-(d_xx+d_yy)^n]F
150           DO K=1,Nr           DO K=1,Nr
151            DO J=1,sNy            DO J=1,sNy
152             DO I=1,sNx             DO I=1,sNx
153              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-tmpFld(i,j,k,bi,bj)              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
154         &       -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
155             ENDDO             ENDDO
156            ENDDO            ENDDO
157           ENDDO           ENDDO
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22