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

Diff of /MITgcm/pkg/shap_filt/shap_filt_tracer_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 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_S4(  CBOP
7       U           field,  C     !ROUTINE: SHAP_FILT_TRACER_S4
8       I           myTime, myThid )  C     !INTERFACE:
9  C     /==========================================================\        SUBROUTINE SHAP_FILT_TRACER_S4(
10  C     | S/R SHAP_FILT_TRACER                                     |       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_S4
15    C     | o Applies Shapiro filter to tracer field (cell center).
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     *==========================================================*
19    C     \ev
20    
21    C     !USES:
22        IMPLICIT NONE        IMPLICIT NONE
23    
24  C     == Global variables ===  C     == Global variables ===
25  #include "SIZE.h"  #include "SIZE.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  #include "PARAMS.h"  #include "PARAMS.h"
28  #include "GRID.h"  #include "GRID.h"
29  #include "SHAP_FILT.h"  #include "SHAP_FILT.h"
 #include "SHAP_FILT_TRACER.h"  
30    
31    C     !INPUT/OUTPUT PARAMETERS:
32  C     == Routine arguments  C     == Routine arguments
33        _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)  C     field :: cell-centered 2D field on which filter applies
34    C     tmpFld :: working temporary array
35    C     kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
36    C     myTime :: Current time in simulation
37    C     myThid :: Thread number for this instance of SHAP_FILT_TRACER_S4
38          INTEGER kSize
39          _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
40          _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
41        _RL     myTime        _RL     myTime
42        INTEGER myThid        INTEGER myThid
43    
44  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
45    
46    C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER bi,bj,K,I,J,N        INTEGER bi,bj,K,I,J,N
49        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50    CEOP
51    
52        IF (nShapT.gt.0) THEN        IF (nShapT.gt.0) THEN
53    
54          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
55           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
56            DO K=1,Nr            DO K=1,kSize
57             DO J=1,sNy             DO J=1-OLy,sNy+Oly
58              DO I=1,sNx              DO I=1-Olx,sNx+Olx
59               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)               tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
60              ENDDO              ENDDO
61             ENDDO             ENDDO
# Line 51  C      d_xx^n tmpFld Line 68  C      d_xx^n tmpFld
68    
69         DO N=1,nShapT         DO N=1,nShapT
70    
71          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.Nr) THEN
72              _EXCH_XYZ_R8( tmpFld, myThid )
73            ELSE
74              _EXCH_XY_R8( tmpFld, myThid )
75            ENDIF
76    
77          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
78           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
79            DO K=1,Nr            DO K=1,kSize
80    
81             DO J=1,sNy             DO J=1,sNy
82              DO I=1,sNx              DO I=1,sNx
# Line 79  C      d_xx^n tmpFld Line 100  C      d_xx^n tmpFld
100    
101         ENDDO         ENDDO
102    
103  C      F <-  [1-d_xx^n]F  C      F <-  [1 - d_xx^n *deltaT/tau].F
104         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
105          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
106           DO K=1,Nr           DO K=1,kSize
107            DO J=1,sNy            DO J=1,sNy
108             DO I=1,sNx             DO I=1,sNx
109              tmpFld(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)
110              field(i,j,k,bi,bj)=tmpFld(i,j,k,bi,bj)       &              -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
111                tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
112             ENDDO             ENDDO
113            ENDDO            ENDDO
114           ENDDO           ENDDO
# Line 98  C      d_yy^n tmpFld Line 120  C      d_yy^n tmpFld
120    
121         DO N=1,nShapT         DO N=1,nShapT
122    
123          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.1) THEN
124              _EXCH_XY_R8( tmpFld, myThid )
125            ELSE
126              _EXCH_XYZ_R8( tmpFld, myThid )
127            ENDIF
128    
129          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
130           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
131            DO K=1,Nr            DO K=1,kSize
132    
133             DO J=1,sNy             DO J=1,sNy
134              DO I=1,sNx              DO I=1,sNx
# Line 126  C      d_yy^n tmpFld Line 152  C      d_yy^n tmpFld
152    
153         ENDDO         ENDDO
154    
155  C      F <-  [1-d_yy^n]F  C      F <-  [1 - d_yy^n *deltaT/tau].F
156         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
157          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
158           DO K=1,Nr           DO K=1,kSize
159            DO J=1,sNy            DO J=1,sNy
160             DO I=1,sNx             DO I=1,sNx
161              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)
162         &              -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
163             ENDDO             ENDDO
164            ENDDO            ENDDO
165           ENDDO           ENDDO
166          ENDDO          ENDDO
167         ENDDO         ENDDO
168    
169         _EXCH_XYZ_R8( field, myThid )          IF (kSize.EQ.Nr) THEN
170              _EXCH_XYZ_R8( field, myThid )
171            ELSEIF (kSize.EQ.1) THEN
172              _EXCH_XY_R8( field, myThid )
173            ELSE
174              STOP 'S/R SHAP_FILT_TRACER_S4: kSize is wrong'
175            ENDIF
176    
177        ENDIF        ENDIF
178  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22