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

Annotation of /MITgcm/pkg/shap_filt/shap_filt_tracer_s1.F

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


Revision 1.4 - (hide annotations) (download)
Mon Mar 4 02:28:25 2002 UTC (22 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint51k_post, checkpoint47e_post, checkpoint52l_pre, hrcube4, hrcube5, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint50c_post, checkpoint46f_post, checkpoint52d_pre, checkpoint48e_post, checkpoint50c_pre, checkpoint44f_post, checkpoint46b_post, checkpoint52j_pre, checkpoint51o_pre, checkpoint51l_post, checkpoint48i_post, checkpoint46l_pre, checkpoint52l_post, checkpoint52k_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, checkpoint50d_post, checkpoint52f_post, checkpoint50b_pre, checkpoint51f_post, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint51t_post, checkpoint51n_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint47a_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint52e_pre, checkpoint52e_post, checkpoint51n_pre, checkpoint47d_post, checkpoint53d_post, checkpoint46d_pre, checkpoint48d_post, checkpoint48f_post, checkpoint45d_post, checkpoint52b_pre, checkpoint46j_pre, checkpoint51l_pre, checkpoint52m_post, checkpoint44h_pre, checkpoint48h_post, checkpoint51q_post, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, checkpoint52c_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, checkpoint48a_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52f_pre, checkpoint47j_post, checkpoint53c_post, branch-exfmods-tag, checkpoint44g_post, branchpoint-genmake2, checkpoint46e_pre, checkpoint51r_post, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint53a_post, checkpoint46, checkpoint47b_post, checkpoint46h_pre, checkpoint52d_post, checkpoint46m_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint44h_post, checkpoint46g_post, checkpoint52a_pre, checkpoint50h_post, checkpoint52i_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51i_pre, checkpoint52h_pre, checkpoint53f_post, checkpoint52j_post, checkpoint47f_post, checkpoint50e_post, checkpoint46i_post, checkpoint46c_post, branch-netcdf, checkpoint50d_pre, checkpoint52n_post, checkpoint53b_pre, checkpoint46e_post, checkpoint51e_post, checkpoint47, checkpoint45, checkpoint48, checkpoint49, checkpoint46h_post, checkpoint51o_post, checkpoint51f_pre, checkpoint48g_post, checkpoint53b_post, checkpoint47h_post, checkpoint52a_post, checkpoint44f_pre, checkpoint51g_post, ecco_c52_e35, checkpoint46d_post, checkpoint50b_post, checkpoint51m_post, checkpoint53d_pre, checkpoint51a_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-exfmods-curt, branch-genmake2, branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.3: +3 -3 lines
  include the overlap when loads the field in temp. array.

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_tracer_s1.F,v 1.3 2002/03/04 01:32:55 jmc Exp $
2 jmc 1.3 C $Name: $
3 adcroft 1.2
4     #include "SHAP_FILT_OPTIONS.h"
5 jmc 1.3
6     CBOP
7     C !ROUTINE: SHAP_FILT_TRACER_S1
8     C !INTERFACE:
9 adcroft 1.2 SUBROUTINE SHAP_FILT_TRACER_S1(
10 jmc 1.3 U field, tmpFld,
11     I kSize, myTime, myThid )
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | S/R SHAP_FILT_TRACER_S1
15     C | o Applies Shapiro filter to tracer field (cell center).
16     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 adcroft 1.2 IMPLICIT NONE
23 jmc 1.3
24 adcroft 1.2 C == Global variables ===
25     #include "SIZE.h"
26     #include "EEPARAMS.h"
27     #include "PARAMS.h"
28     #include "GRID.h"
29     #include "SHAP_FILT.h"
30    
31 jmc 1.3 C !INPUT/OUTPUT PARAMETERS:
32 adcroft 1.2 C == Routine arguments
33 jmc 1.3 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 adcroft 1.2 _RL myTime
42     INTEGER myThid
43 jmc 1.3
44 adcroft 1.2 #ifdef ALLOW_SHAP_FILT
45    
46 jmc 1.3 C !LOCAL VARIABLES:
47 adcroft 1.2 C == Local variables ==
48     INTEGER bi,bj,K,I,J,N
49     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50     _RL tmpScal
51 jmc 1.3 CEOP
52 adcroft 1.2
53     IF (nShapT.gt.0) THEN
54    
55     DO bj=myByLo(myThid),myByHi(myThid)
56     DO bi=myBxLo(myThid),myBxHi(myThid)
57 jmc 1.3 DO K=1,kSize
58 jmc 1.4 DO J=1-OLy,sNy+OLy
59     DO I=1-OLx,sNx+OLx
60 adcroft 1.2 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
61     ENDDO
62     ENDDO
63     ENDDO
64     ENDDO
65     ENDDO
66    
67    
68     C d_xx^n tmpFld
69    
70     DO N=1,nShapT
71    
72 jmc 1.3 IF (kSize.EQ.Nr) THEN
73     _EXCH_XYZ_R8( tmpFld, myThid )
74     ELSE
75     _EXCH_XY_R8( tmpFld, myThid )
76     ENDIF
77 adcroft 1.2
78     DO bj=myByLo(myThid),myByHi(myThid)
79     DO bi=myBxLo(myThid),myBxHi(myThid)
80 jmc 1.3 DO K=1,kSize
81 adcroft 1.2
82     DO J=1,sNy
83     DO I=1,sNx
84     tmpGrd(i,j) = -0.25*(
85     & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
86     & *_maskW(i+1,j,k,bi,bj)
87     & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
88     & *_maskW(i,j,k,bi,bj) )
89     ENDDO
90     ENDDO
91    
92     DO J=1,sNy
93     DO I=1,sNx
94     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
95     ENDDO
96     ENDDO
97    
98     ENDDO
99     ENDDO
100     ENDDO
101    
102     ENDDO
103    
104 jmc 1.3 C F <- [1 - d_xx^n *deltaT/tau].F
105 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
106     DO bi=myBxLo(myThid),myBxHi(myThid)
107 jmc 1.3 DO K=1,kSize
108 adcroft 1.2 DO J=1,sNy
109     DO I=1,sNx
110 jmc 1.3 tmpScal=field(i,j,k,bi,bj)
111     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
112     & -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
113     tmpFld(i,j,k,bi,bj)=tmpScal
114 adcroft 1.2 ENDDO
115     ENDDO
116     ENDDO
117     ENDDO
118     ENDDO
119    
120    
121     C d_yy^n tmpFld
122    
123     DO N=1,nShapT
124    
125 jmc 1.3 IF (kSize.EQ.Nr) THEN
126     _EXCH_XYZ_R8( tmpFld, myThid )
127     ELSE
128     _EXCH_XY_R8( tmpFld, myThid )
129     ENDIF
130 adcroft 1.2
131     DO bj=myByLo(myThid),myByHi(myThid)
132     DO bi=myBxLo(myThid),myBxHi(myThid)
133 jmc 1.3 DO K=1,kSize
134 adcroft 1.2
135     DO J=1,sNy
136     DO I=1,sNx
137     tmpGrd(i,j) = -0.25*(
138     & ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
139     & *_maskS(i,j+1,k,bi,bj)
140     & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
141     & *_maskS(i,j,k,bi,bj) )
142     ENDDO
143     ENDDO
144    
145     DO J=1,sNy
146     DO I=1,sNx
147     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
148     ENDDO
149     ENDDO
150    
151     ENDDO
152     ENDDO
153     ENDDO
154    
155     ENDDO
156    
157 jmc 1.3 C F <- [1 - d_yy^n *deltaT/tau].F
158 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
159     DO bi=myBxLo(myThid),myBxHi(myThid)
160 jmc 1.3 DO K=1,kSize
161 adcroft 1.2 DO J=1,sNy
162     DO I=1,sNx
163 jmc 1.3 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
164     & -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
165 adcroft 1.2 ENDDO
166     ENDDO
167     ENDDO
168     ENDDO
169     ENDDO
170    
171 jmc 1.3 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 adcroft 1.2
179     ENDIF
180     #endif /* ALLOW_SHAP_FILT */
181    
182     RETURN
183     END

  ViewVC Help
Powered by ViewVC 1.1.22