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

Diff of /MITgcm/pkg/shap_filt/shap_filt_uv_s4.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, Mon Mar 4 01:32:55 2002 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "SHAP_FILT_OPTIONS.h"  #include "SHAP_FILT_OPTIONS.h"
5    
6        SUBROUTINE SHAP_FILT_UV_S4(  CBOP
7       U           uFld, vFld,  C     !ROUTINE: SHAP_FILT_UV_S4
8       I           myTime, myThid )  C     !INTERFACE:
9  C     /==========================================================\        SUBROUTINE SHAP_FILT_UV_S4(
10  C     | S/R SHAP_FILT_UV                                         |       U           uFld, vFld, tmpFldU, tmpFldV,
11  C     | Applies Shapiro filter to tracer field over one XY slice |       I           kSize, myTime, myThid )
12  C     | of one tile at a time.                                   |  C     !DESCRIPTION: \bv
13  C     \==========================================================/  C     *==========================================================*
14    C     | S/R SHAP_FILT_UV_S4
15    C     | o Applies Shapiro filter to velocity field (u & v).
16    C     | o use filtering function "S4" = [1 - d_xx^n][1- d_yy^n]
17    C     |     with no grid spacing (computational Filter) ;
18    C     |     include No-Slip option
19    C     *==========================================================*
20    C     \ev
21    
22    C     !USES:
23        IMPLICIT NONE        IMPLICIT NONE
24    
25  C     == Global variables ===  C     == Global variables ===
# Line 18  C     == Global variables === Line 27  C     == Global variables ===
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GRID.h"  #include "GRID.h"
 #ifdef ALLOW_SHAP_FILT  
30  #include "SHAP_FILT.h"  #include "SHAP_FILT.h"
 #include "SHAP_FILT_UV.h"  
 #endif  
31    
32    C     !INPUT/OUTPUT PARAMETERS:
33  C     == Routine arguments  C     == Routine arguments
34        _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)  C     uFld :: velocity field (U component) on which filter applies
35        _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)  C     vFld :: velocity field (V component) on which filter applies
36    C     tmpFldU :: working temporary array
37    C     tmpFldV :: working temporary array
38    C     kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
39    C     myTime :: Current time in simulation
40    C     myThid :: Thread number for this instance of SHAP_FILT_UV_S4
41          INTEGER kSize
42          _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
43          _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
44          _RL tmpFldU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
45          _RL tmpFldV(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
46        _RL     myTime        _RL     myTime
47        INTEGER myThid        INTEGER myThid
48    
49  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
50    
51    C     !LOCAL VARIABLES:
52  C     == Local variables ==  C     == Local variables ==
53        INTEGER bi,bj,K,I,J,N        INTEGER bi,bj,k,i,j,N
54        _RL tmpGrdU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpGrdU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55        _RL tmpGrdV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpGrdV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56        _RL maskZj,maskZp        _RL maskZj,maskZp
57          _RL noSlipFact
58    CEOP
59    
60          noSlipFact = Shap_noSlip*2. _d 0
61    
62        IF (nShapUV.gt.0) THEN        IF (nShapUV.gt.0) THEN
63    
64          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
65           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
66            DO K=1,Nr            DO K=1,kSize
67             DO J=1,sNy             DO J=1-OLy,sNy+OLy
68              DO I=1,sNx+1              DO I=1-OLx,sNx+OLx
69               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
70       &                *_maskW(i,j,k,bi,bj)       &                *_maskW(i,j,k,bi,bj)
             ENDDO  
            ENDDO  
            DO J=1,sNy+1  
             DO I=1,sNx  
71               tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)               tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
72       &                *_maskS(i,j,k,bi,bj)       &                *_maskS(i,j,k,bi,bj)
73              ENDDO              ENDDO
# Line 63  C      d_xx^n tmpFld Line 81  C      d_xx^n tmpFld
81    
82         DO N=1,nShapUV         DO N=1,nShapUV
83    
84          CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
85              CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
86            ELSE
87              CALL EXCH_UV_XY_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
88            ENDIF
89    
90          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
91           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
92            DO K=1,Nr            DO K=1,kSize
93    
94  C          Uxx  C          Uxx
95             DO J=1,sNy             DO J=1,sNy
# Line 108  C          Vyy Line 129  C          Vyy
129    
130         ENDDO         ENDDO
131    
132  C      F <-  [1-d_xx^n]F  C      F <-  [1 - d_xx^n *deltaT/tau].F
133         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
134          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
135           DO K=1,Nr           DO K=1,kSize
136            DO J=1,sNy            DO J=1,sNy
137             DO I=1,sNx+1             DO I=1,sNx+1
138              tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
139              uFld(i,j,k,bi,bj)=tmpFldU(i,j,k,bi,bj)       &             -tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
140                tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
141             ENDDO             ENDDO
142            ENDDO            ENDDO
143            DO J=1,sNy+1            DO J=1,sNy+1
144             DO I=1,sNx             DO I=1,sNx
145              tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-tmpFldV(i,j,k,bi,bj)              vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
146              vFld(i,j,k,bi,bj)=tmpFldV(i,j,k,bi,bj)       &             -tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
147                tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
148             ENDDO             ENDDO
149            ENDDO            ENDDO
150           ENDDO           ENDDO
# Line 133  C      d_yy^n tmpFld Line 156  C      d_yy^n tmpFld
156    
157         DO N=1,nShapUV         DO N=1,nShapUV
158    
159          CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
160              CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
161            ELSE
162              CALL EXCH_UV_XY_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
163            ENDIF
164    
165          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
166           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
167            DO K=1,Nr            DO K=1,kSize
168    
169  C          Uyy  C          Uyy
170             DO J=1,sNy             DO J=1,sNy
# Line 149  C          Uyy Line 176  C          Uyy
176               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
177       &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp       &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
178       &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj       &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj
179  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
      &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)  
 #endif  
180       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
181              ENDDO              ENDDO
182             ENDDO             ENDDO
# Line 164  C          Uyy Line 189  C          Uyy
189               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
190       &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp       &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
191       &       -(tmpFldU(i, j ,k,bi,bj)-0*tmpFldU(i,j-1,k,bi,bj))*maskZj       &       -(tmpFldU(i, j ,k,bi,bj)-0*tmpFldU(i,j-1,k,bi,bj))*maskZj
192  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
      &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)  
 #endif  
193       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
194              ENDDO              ENDDO
195              J=sNy              J=sNy
# Line 176  C          Uyy Line 199  C          Uyy
199               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
200       &        (0*tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp       &        (0*tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
201       &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj       &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj
202  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
      &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)  
 #endif  
203       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
204              ENDDO              ENDDO
205             ENDIF             ENDIF
# Line 199  C          Vxx Line 220  C          Vxx
220               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
221       &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp       &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
222       &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj       &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj
223  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
      &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)  
 #endif  
224       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
225              ENDDO              ENDDO
226             ENDDO             ENDDO
# Line 214  C          Vxx Line 233  C          Vxx
233               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
234       &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp       &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
235       &       -(tmpFldV( i ,j,k,bi,bj)-0*tmpFldV(i-1,j,k,bi,bj))*maskZj       &       -(tmpFldV( i ,j,k,bi,bj)-0*tmpFldV(i-1,j,k,bi,bj))*maskZj
236  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
237       &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)       &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
 #endif  
238       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
239              ENDDO              ENDDO
240              DO J=1,sNy+1,sNy              DO J=1,sNy+1,sNy
# Line 226  C          Vxx Line 244  C          Vxx
244               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
245       &        (0*tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp       &        (0*tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
246       &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj       &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj
247  #ifdef NO_SLIP_SHAP       &       -noSlipFact*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
      &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)  
 #endif  
248       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
249              ENDDO              ENDDO
250             ENDIF             ENDIF
# Line 245  C          Vxx Line 261  C          Vxx
261    
262         ENDDO         ENDDO
263    
264  C      F <-  [1-d_yy^n]F  C      F <-  [1 - d_yy^n *deltaT/tau].F
265         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
266          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
267           DO K=1,Nr           DO K=1,kSize
268            DO J=1,sNy            DO J=1,sNy
269             DO I=1,sNx+1             DO I=1,sNx+1
270              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
271         &             -tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
272             ENDDO             ENDDO
273            ENDDO            ENDDO
274            DO J=1,sNy+1            DO J=1,sNy+1
275             DO I=1,sNx             DO I=1,sNx
276              vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-tmpFldV(i,j,k,bi,bj)              vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
277         &             -tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
278             ENDDO             ENDDO
279            ENDDO            ENDDO
280           ENDDO           ENDDO
281          ENDDO          ENDDO
282         ENDDO         ENDDO
283    
284            IF (kSize.EQ.Nr) THEN
285              CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
286            ELSEIF (kSize.EQ.1) THEN
287              CALL EXCH_UV_XY_RL(uFld,vFld,.TRUE.,myThid)
288            ELSE
289              STOP 'S/R SHAP_FILT_UV_S4: kSize is wrong'
290            ENDIF
291    
292        ENDIF        ENDIF
293  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
294    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22