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

Diff of /MITgcm/pkg/shap_filt/shap_filt_tracer_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 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    CBOP
7    C     !ROUTINE: SHAP_FILT_TRACER_S1
8    C     !INTERFACE:
9        SUBROUTINE SHAP_FILT_TRACER_S1(        SUBROUTINE SHAP_FILT_TRACER_S1(
10       U           field,       U           field, tmpFld,
11       I           myTime, myThid )       I           kSize, myTime, myThid )
12  C     /==========================================================\  C     !DESCRIPTION: \bv
13  C     | S/R SHAP_FILT_TRACER                                     |  C     *==========================================================*
14  C     | Applies Shapiro filter to tracer field over one XY slice |  C     | S/R SHAP_FILT_TRACER_S1
15  C     | of one tile at a time.                                   |  C     | o Applies Shapiro filter to tracer field (cell center).
16  C     \==========================================================/  C     | o use filtering function "S1" = [1 - d_xx^n - 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_S1
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        _RL tmpScal        _RL tmpScal
51    CEOP
52    
53        IF (nShapT.gt.0) THEN        IF (nShapT.gt.0) THEN
54    
55          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
56           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
57            DO K=1,Nr            DO K=1,kSize
58             DO J=1,sNy             DO J=1,sNy
59              DO I=1,sNx              DO I=1,sNx
60               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 52  C      d_xx^n tmpFld Line 69  C      d_xx^n tmpFld
69    
70         DO N=1,nShapT         DO N=1,nShapT
71    
72          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.Nr) THEN
73              _EXCH_XYZ_R8( tmpFld, myThid )
74            ELSE
75              _EXCH_XY_R8( tmpFld, myThid )
76            ENDIF
77    
78          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
79           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
80            DO K=1,Nr            DO K=1,kSize
81    
82             DO J=1,sNy             DO J=1,sNy
83              DO I=1,sNx              DO I=1,sNx
# Line 80  C      d_xx^n tmpFld Line 101  C      d_xx^n tmpFld
101    
102         ENDDO         ENDDO
103    
104  C      F <-  [1-d_xx^n]F  C      F <-  [1 - d_xx^n *deltaT/tau].F
105         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
106          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
107           DO K=1,Nr           DO K=1,kSize
108            DO J=1,sNy            DO J=1,sNy
109             DO I=1,sNx             DO I=1,sNx
110              tmpScal=tmpFld(i,j,k,bi,bj)              tmpScal=field(i,j,k,bi,bj)
111              tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
112              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal       &          -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
113                tmpFld(i,j,k,bi,bj)=tmpScal
114             ENDDO             ENDDO
115            ENDDO            ENDDO
116           ENDDO           ENDDO
# Line 100  C      d_yy^n tmpFld Line 122  C      d_yy^n tmpFld
122    
123         DO N=1,nShapT         DO N=1,nShapT
124    
125          _EXCH_XYZ_R8( tmpFld, myThid )          IF (kSize.EQ.Nr) THEN
126              _EXCH_XYZ_R8( tmpFld, myThid )
127            ELSE
128              _EXCH_XY_R8( tmpFld, myThid )
129            ENDIF
130    
131          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
132           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
133            DO K=1,Nr            DO K=1,kSize
134    
135             DO J=1,sNy             DO J=1,sNy
136              DO I=1,sNx              DO I=1,sNx
# Line 128  C      d_yy^n tmpFld Line 154  C      d_yy^n tmpFld
154    
155         ENDDO         ENDDO
156    
157  C      F <-  [1-d_yy^n]F  C      F <-  [1 - d_yy^n *deltaT/tau].F
158         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
159          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
160           DO K=1,Nr           DO K=1,kSize
161            DO J=1,sNy            DO J=1,sNy
162             DO I=1,sNx             DO I=1,sNx
163              tmpScal=tmpFld(i,j,k,bi,bj)              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
164              field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal       &          -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
165             ENDDO             ENDDO
166            ENDDO            ENDDO
167           ENDDO           ENDDO
168          ENDDO          ENDDO
169         ENDDO         ENDDO
170    
171         _EXCH_XYZ_R8( field, myThid )          IF (kSize.EQ.Nr) THEN
172              _EXCH_XYZ_R8( field, myThid )
173            ELSEIF (kSize.EQ.1) THEN
174              _EXCH_XY_R8( field, myThid )
175            ELSE
176              STOP 'S/R SHAP_FILT_TRACER_S1: kSize is wrong'
177            ENDIF
178    
179        ENDIF        ENDIF
180  #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