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

Diff of /MITgcm/pkg/shap_filt/shap_filt_uv_s1.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_S1(  CBOP
7       U           uFld, vFld,  C     !ROUTINE: SHAP_FILT_UV_S1
8       I           myTime, myThid )  C     !INTERFACE:
9  C     /==========================================================\        SUBROUTINE SHAP_FILT_UV_S1(
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_S1
15    C     | o Applies Shapiro filter to velocity field (u & v).
16    C     | o use filtering function "S1" = [1 - d_xx^n - 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 19  C     == Global variables === Line 28  C     == Global variables ===
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GRID.h"  #include "GRID.h"
30  #include "SHAP_FILT.h"  #include "SHAP_FILT.h"
 #include "SHAP_FILT_UV.h"  
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_S1
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        _RL tmpScal        _RL tmpScal
59    CEOP
60    
61          noSlipFact = Shap_noSlip*2. _d 0
62    
63        IF (nShapUV.gt.0) THEN        IF (nShapUV.gt.0) THEN
64    
65          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
66           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
67            DO K=1,Nr            DO K=1,kSize
68             DO J=1,sNy             DO J=1-OLy,sNy+OLy
69              DO I=1,sNx+1              DO I=1-OLx,sNx+OLx
70               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
71       &                *_maskW(i,j,k,bi,bj)       &                *_maskW(i,j,k,bi,bj)
             ENDDO  
            ENDDO  
            DO J=1,sNy+1  
             DO I=1,sNx  
72               tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)               tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
73       &                *_maskS(i,j,k,bi,bj)       &                *_maskS(i,j,k,bi,bj)
74              ENDDO              ENDDO
# Line 62  C      d_xx^n tmpFld Line 82  C      d_xx^n tmpFld
82    
83         DO N=1,nShapUV         DO N=1,nShapUV
84    
85          CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
86              CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
87            ELSE
88              CALL EXCH_UV_XY_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
89            ENDIF
90    
91          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
92           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
93            DO K=1,Nr            DO K=1,kSize
94    
95  C          Uxx  C          Uxx
96             DO J=1,sNy             DO J=1,sNy
# Line 107  C          Vyy Line 130  C          Vyy
130    
131         ENDDO         ENDDO
132    
133  C      F <-  [1-d_xx^n]F  C      F <-  [1 - d_xx^n *deltaT/tau].F
134         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
135          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
136           DO K=1,Nr           DO K=1,kSize
137            DO J=1,sNy            DO J=1,sNy
138             DO I=1,sNx+1             DO I=1,sNx+1
139              tmpScal=tmpFldU(i,j,k,bi,bj)              tmpScal = uFld(i,j,k,bi,bj)
140              tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)              uFld(i,j,k,bi,bj) = uFld(i,j,k,bi,bj)
141       &                *_maskW(i,j,k,bi,bj)       &         -0.5*tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
142              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-0.5*tmpScal              tmpFldU(i,j,k,bi,bj) = tmpScal*_maskW(i,j,k,bi,bj)
143             ENDDO             ENDDO
144            ENDDO            ENDDO
145            DO J=1,sNy+1            DO J=1,sNy+1
146             DO I=1,sNx             DO I=1,sNx
147              tmpScal=tmpFldV(i,j,k,bi,bj)              tmpScal = vFld(i,j,k,bi,bj)
148              tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)              vFld(i,j,k,bi,bj) = vFld(i,j,k,bi,bj)
149       &                *_maskS(i,j,k,bi,bj)       &         -0.5*tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
150              vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-0.5*tmpScal              tmpFldV(i,j,k,bi,bj) = tmpScal*_maskS(i,j,k,bi,bj)
151             ENDDO             ENDDO
152            ENDDO            ENDDO
153           ENDDO           ENDDO
# Line 136  C      d_yy^n tmpFld Line 159  C      d_yy^n tmpFld
159    
160         DO N=1,nShapUV         DO N=1,nShapUV
161    
162          CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
163              CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
164            ELSE
165              CALL EXCH_UV_XY_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
166            ENDIF
167    
168          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
169           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
170            DO K=1,Nr            DO K=1,kSize
171    
172  C          Uyy  C          Uyy
173             DO J=1,sNy             DO J=1,sNy
# Line 152  C          Uyy Line 179  C          Uyy
179               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
180       &        (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
181       &       -(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
182  #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  
183       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
184              ENDDO              ENDDO
185             ENDDO             ENDDO
186    
187             IF (useCubedSphereExchange) THEN             IF (useCubedSphereExchange) THEN
             J=1  
188              DO I=1,sNx+1,sNx              DO I=1,sNx+1,sNx
189                J=1
190               maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)               maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)
191               maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)               maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)
192               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
193       &        (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
194       &       -(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
195  #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  
196       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
             ENDDO  
197              J=sNy              J=sNy
             DO I=1,sNx+1,sNx  
198               maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)               maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)
199               maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)               maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)
200               tmpGrdU(i,j) = -0.25*(               tmpGrdU(i,j) = -0.25*(
201       &        (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
202       &       -(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
203  #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  
204       &             )*_maskW(i,j,k,bi,bj)       &             )*_maskW(i,j,k,bi,bj)
205              ENDDO              ENDDO
206             ENDIF             ENDIF
# Line 202  C          Vxx Line 221  C          Vxx
221               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
222       &        (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
223       &       -(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
224  #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  
225       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
226              ENDDO              ENDDO
227             ENDDO             ENDDO
# Line 217  C          Vxx Line 234  C          Vxx
234               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
235       &        (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
236       &       -(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
237  #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  
238       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
             ENDDO  
             DO J=1,sNy+1,sNy  
239              I=sNx              I=sNx
240               maskZj=maskW( i ,j-1,k,bi,bj)*maskW( i , j ,k,bi,bj)               maskZj=maskW( i ,j-1,k,bi,bj)*maskW( i , j ,k,bi,bj)
241               maskZp=maskW(i+1,j-1,k,bi,bj)*maskW(i+1, j ,k,bi,bj)               maskZp=maskW(i+1,j-1,k,bi,bj)*maskW(i+1, j ,k,bi,bj)
242               tmpGrdV(i,j) = -0.25*(               tmpGrdV(i,j) = -0.25*(
243       &        (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
244       &       -(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
245  #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  
246       &             )*_maskS(i,j,k,bi,bj)       &             )*_maskS(i,j,k,bi,bj)
247              ENDDO              ENDDO
248             ENDIF             ENDIF
# Line 248  C          Vxx Line 259  C          Vxx
259    
260         ENDDO         ENDDO
261    
262  C      F <-  [1-d_yy^n]F  C      F <-  [1 - d_yy^n *deltaT/tau].F
263         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
264          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
265           DO K=1,Nr           DO K=1,kSize
266            DO J=1,sNy            DO J=1,sNy
267             DO I=1,sNx+1             DO I=1,sNx+1
268              tmpScal=tmpFldU(i,j,k,bi,bj)              uFld(i,j,k,bi,bj) = uFld(i,j,k,bi,bj)
269              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-0.5*tmpScal       &         -0.5*tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
270             ENDDO             ENDDO
271            ENDDO            ENDDO
272            DO J=1,sNy+1            DO J=1,sNy+1
273             DO I=1,sNx             DO I=1,sNx
274              tmpScal=tmpFldV(i,j,k,bi,bj)              vFld(i,j,k,bi,bj) = vFld(i,j,k,bi,bj)
275              vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-0.5*tmpScal       &         -0.5*tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
276             ENDDO             ENDDO
277            ENDDO            ENDDO
278           ENDDO           ENDDO
279          ENDDO          ENDDO
280         ENDDO         ENDDO
281    
282            IF (kSize.EQ.Nr) THEN
283              CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
284            ELSEIF (kSize.EQ.1) THEN
285              CALL EXCH_UV_XY_RL(uFld,vFld,.TRUE.,myThid)
286            ELSE
287              STOP 'S/R SHAP_FILT_UV_S1: kSize is wrong'
288            ENDIF
289    
290        ENDIF        ENDIF
291  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
292    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22