/[MITgcm]/MITgcm/verification/aim.5l_cs/code/shap_filt_uv_s2.F
ViewVC logotype

Diff of /MITgcm/verification/aim.5l_cs/code/shap_filt_uv_s2.F

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

revision 1.1 by jmc, Wed Jan 9 00:28:55 2002 UTC revision 1.2 by jmc, Mon Mar 4 01:39:50 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_S2(  CBOP
7       U           uFld, vFld,  C     !ROUTINE: SHAP_FILT_UV_S2
8       I           myTime, myThid )  C     !INTERFACE:
9  C     /==========================================================\        SUBROUTINE SHAP_FILT_UV_S2(
10  C     | S/R SHAP_FILT_UV_S2                                      |       U           uFld, vFld, tmpFldU, tmpFldV,
11  C     | Applies Shapiro filter to U,V 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_S2
15    C     | o Applies Shapiro filter to velocity field (u & v).
16    C     | o use filtering function "S2" = [1 - (d_xx+d_yy)^n]
17    C     | o Options for computational filter (no grid spacing)
18    C     |   or physical space filter (with grid spacing) or both.
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_S2
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------  C------
52  C  Combine computational Filter of Div & Vorticity  C  Combine computational Filter of Div & Vorticity
53  C   and Physical Filter of U,V field  C   and Physical Filter of U,V field
# Line 38  C                        and return filt Line 58  C                        and return filt
58  C   nShapUVPhys = nShapUV  ==> Filter in Physical space only (power nShapUV)  C   nShapUVPhys = nShapUV  ==> Filter in Physical space only (power nShapUV)
59  C------    C------  
60    
61    C     !LOCAL VARIABLES:
62  C     == Local variables ==  C     == Local variables ==
63        INTEGER bi,bj,K,I,J,N        INTEGER bi,bj,k,i,j,N
64        _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66        _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67        _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68        _RS maskZ        _RS maskZ
69    CEOP
70    
71        IF (nShapUV.GT.0 .AND. Shap_uvtau.GT.0.) THEN        IF (nShapUV.GT.0 .AND. Shap_uvtau.GT.0.) THEN
72    
73          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
74           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
75            DO K=1,Nr            DO K=1,kSize
76             DO J=1-Oly,sNy+Oly             DO J=1-Oly,sNy+Oly
77              DO I=1-Olx,sNx+Olx              DO I=1-Olx,sNx+Olx
78               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)               tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
# Line 69  C    [d_xx+d_yy]^n tmpFld Line 91  C    [d_xx+d_yy]^n tmpFld
91    
92         DO N=1,nShapUV         DO N=1,nShapUV
93    
94          CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
95              CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
96            ELSE
97              CALL EXCH_UV_XY_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
98            ENDIF
99    
100          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
101           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
102            DO K=1,Nr            DO K=1,kSize
103    
104  C    [d_xx+d_yy] tmpFld  C    [d_xx+d_yy] tmpFld
105           IF (N.LE.nShapUVPhys) THEN           IF (N.LE.nShapUVPhys) THEN
# Line 116  c--- Line 142  c---
142              IF (maskZ.GE.2.) THEN              IF (maskZ.GE.2.) THEN
143               vort3(I,J)=               vort3(I,J)=
144       &          tmpFldV(I,J,k,bi,bj)       &          tmpFldV(I,J,k,bi,bj)
 c    &         -tmpFldV(I-1,J,k,bi,bj)  
145       &         -tmpFldU(I,J,k,bi,bj)       &         -tmpFldU(I,J,k,bi,bj)
146       &         +tmpFldU(I,J-1,k,bi,bj)       &         +tmpFldU(I,J-1,k,bi,bj)
147               vort3(I,J)=vort3(I,J)*4.d0/3.d0               vort3(I,J)=vort3(I,J)*4.d0/3.d0
# Line 130  c--- Line 155  c---
155       &                                 +maskS(i-1,j,k,bi,bj)       &                                 +maskS(i-1,j,k,bi,bj)
156              IF (maskZ.GE.2.) THEN              IF (maskZ.GE.2.) THEN
157               vort3(I,J)=               vort3(I,J)=
 c    &          tmpFldV(I,J,k,bi,bj)  
158       &         -tmpFldV(I-1,J,k,bi,bj)       &         -tmpFldV(I-1,J,k,bi,bj)
159       &         -tmpFldU(I,J,k,bi,bj)       &         -tmpFldU(I,J,k,bi,bj)
160       &         +tmpFldU(I,J-1,k,bi,bj)       &         +tmpFldU(I,J-1,k,bi,bj)
# Line 146  c--- Line 170  c---
170              IF (maskZ.GE.2.) THEN              IF (maskZ.GE.2.) THEN
171               vort3(I,J)=               vort3(I,J)=
172       &          tmpFldV(I,J,k,bi,bj)       &          tmpFldV(I,J,k,bi,bj)
 c    &         -tmpFldV(I-1,J,k,bi,bj)  
173       &         -tmpFldU(I,J,k,bi,bj)       &         -tmpFldU(I,J,k,bi,bj)
174       &         +tmpFldU(I,J-1,k,bi,bj)       &         +tmpFldU(I,J-1,k,bi,bj)
175               vort3(I,J)=vort3(I,J)*4.d0/3.d0               vort3(I,J)=vort3(I,J)*4.d0/3.d0
# Line 160  c--- Line 183  c---
183       &                                 +maskS(i-1,j,k,bi,bj)       &                                 +maskS(i-1,j,k,bi,bj)
184              IF (maskZ.GE.2.) THEN              IF (maskZ.GE.2.) THEN
185               vort3(I,J)=               vort3(I,J)=
 c    &          tmpFldV(I,J,k,bi,bj)  
186       &         -tmpFldV(I-1,J,k,bi,bj)       &         -tmpFldV(I-1,J,k,bi,bj)
187       &         -tmpFldU(I,J,k,bi,bj)       &         -tmpFldU(I,J,k,bi,bj)
188       &         +tmpFldU(I,J-1,k,bi,bj)       &         +tmpFldU(I,J-1,k,bi,bj)
# Line 228  C end loop N=1,nShapUV Line 250  C end loop N=1,nShapUV
250    
251  c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
252    
253  C      F <-  [1 - (d_xx+d_yy)^n *deltat/tau].F  C      F <-  [1 - (d_xx+d_yy)^n *deltaT/tau].F
254         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
255          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
256           DO K=1,Nr           DO K=1,kSize
257            DO J=1,sNy+1            DO J=1,sNy+1
258             DO I=1,sNx             DO I=1,sNx
259              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)              uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
# Line 248  C      F <-  [1 - (d_xx+d_yy)^n *deltat/ Line 270  C      F <-  [1 - (d_xx+d_yy)^n *deltat/
270          ENDDO          ENDDO
271         ENDDO         ENDDO
272    
273        CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)          IF (kSize.EQ.Nr) THEN
274              CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
275            ELSEIF (kSize.EQ.1) THEN
276              CALL EXCH_UV_XY_RL(uFld,vFld,.TRUE.,myThid)
277            ELSE
278              STOP 'S/R SHAP_FILT_UV_S2: kSize is wrong'
279            ENDIF
280    
281        ENDIF        ENDIF
282  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22