/[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.3 by jmc, Fri Jun 15 15:14:56 2001 UTC revision 1.4 by jmc, Mon Mar 4 01:32:55 2002 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "SHAP_FILT_OPTIONS.h"  #include "SHAP_FILT_OPTIONS.h"
5    
6        SUBROUTINE SHAP_FILT_TRACER_S2(  CBOP
7       U           field,  C     !ROUTINE: SHAP_FILT_TRACER_S2
8       I           myTime, myThid )  C     !INTERFACE:
9  C     /==========================================================\        SUBROUTINE SHAP_FILT_TRACER_S2(
10  C     | S/R SHAP_FILT_TRACER_S2                                  |       U           field, tmpFld,
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_TRACER_S2
15    C     | o Applies Shapiro filter to 2D field (cell center).
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 ===
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
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_TRACER.h"  
31    
32    C     !INPUT/OUTPUT PARAMETERS:
33  C     == Routine arguments  C     == Routine arguments
34        _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)  C     field :: cell-centered 2D field on which filter applies
35    C     tmpFld :: working temporary array
36    C     kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
37    C     myTime :: Current time in simulation
38    C     myThid :: Thread number for this instance of SHAP_FILT_TRACER_S2
39          INTEGER kSize
40          _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
41          _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
42        _RL     myTime        _RL     myTime
43        INTEGER myThid        INTEGER myThid
44    
45  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
46    
47    C     !LOCAL VARIABLES:
48  C     == Local variables ==  C     == Local variables ==
49        INTEGER nShapComput        INTEGER nShapComput
50        INTEGER bi,bj,K,I,J,N        INTEGER bi,bj,K,I,J,N
51        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52    CEOP
53    
54        IF (nShapT.GT.0) THEN        IF (nShapT.gt.0) THEN
55  C-------  C-------
56  C  Apply computational filter ^(nShap-nShapPhys) without grid factor  C  Apply computational filter ^(nShap-nShapPhys) without grid factor
57  C  then apply Physical filter ^nShapPhys  with grid factors  C  then apply Physical filter ^nShapPhys  with grid factors
# Line 42  C------- Line 60  C-------
60    
61          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
62           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
63            DO K=1,Nr            DO K=1,kSize
64             DO J=1-Oly,sNy+Oly             DO J=1-Oly,sNy+Oly
65              DO I=1-Olx,sNx+Olx              DO I=1-Olx,sNx+Olx
66               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
# Line 58  C      ( d_xx +d_yy )^n tmpFld Line 76  C      ( d_xx +d_yy )^n tmpFld
76  C-- Computational Filter  C-- Computational Filter
77         DO N=1,nShapComput         DO N=1,nShapComput
78    
79          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.Nr) THEN
80              _EXCH_XYZ_R8( tmpFld, myThid )
81            ELSE
82              _EXCH_XY_R8( tmpFld, myThid )
83            ENDIF
84    
85          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
86           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
87            DO K=1,Nr            DO K=1,kSize
88    
89             DO J=1,sNy             DO J=1,sNy
90              DO I=1,sNx              DO I=1,sNx
# Line 93  C      end loop N=1,nShapComput Line 115  C      end loop N=1,nShapComput
115         DO N=1,nShapTrPhys         DO N=1,nShapTrPhys
116  C-- Physical space Filter  C-- Physical space Filter
117    
118          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.Nr) THEN
119              _EXCH_XYZ_R8( tmpFld, myThid )
120            ELSE
121              _EXCH_XY_R8( tmpFld, myThid )
122            ENDIF
123    
124          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
125           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
126            DO K=1,Nr            DO K=1,kSize
127    
128             DO J=1,sNy             DO J=1,sNy
129              DO I=1,sNx              DO I=1,sNx
# Line 144  C-- Physical space Filter Line 170  C-- Physical space Filter
170  C      end loop N=1,nShapTrPhys  C      end loop N=1,nShapTrPhys
171         ENDDO         ENDDO
172    
173  C      F <-  [1-(d_xx+d_yy)^n]F  C      F <-  [1 - (d_xx+d_yy)^n *deltaT/tau].F
174         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
175          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
176           DO K=1,Nr           DO K=1,kSize
177            DO J=1,sNy            DO J=1,sNy
178             DO I=1,sNx             DO I=1,sNx
179              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
# Line 158  C      F <-  [1-(d_xx+d_yy)^n]F Line 184  C      F <-  [1-(d_xx+d_yy)^n]F
184          ENDDO          ENDDO
185         ENDDO         ENDDO
186    
187         _EXCH_XYZ_R8( field, myThid )          IF (kSize.EQ.Nr) THEN
188              _EXCH_XYZ_R8( field, myThid )
189            ELSEIF (kSize.EQ.1) THEN
190              _EXCH_XY_R8( field, myThid )
191            ELSE
192              STOP 'S/R SHAP_FILT_TRACER_S4: kSize is wrong'
193            ENDIF
194    
195        ENDIF        ENDIF
196  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.22