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

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

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

Revision 1.3 - (hide annotations) (download)
Mon Mar 4 01:32:55 2002 UTC (22 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint48f_post, checkpoint46k_post, checkpoint51k_post, checkpoint53f_post, checkpoint47j_post, checkpoint53b_pre, checkpoint48d_pre, checkpoint51l_post, checkpoint51j_post, branch-exfmods-tag, checkpoint47e_post, checkpoint44h_pre, checkpoint52l_pre, checkpoint48i_post, checkpoint52e_pre, hrcube4, hrcube5, checkpoint52j_post, checkpoint47f_post, checkpoint48d_post, checkpoint51o_pre, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint52e_post, checkpoint50c_post, checkpoint51n_pre, checkpoint47d_post, checkpoint44f_pre, checkpoint47a_post, checkpoint46f_post, checkpoint52d_pre, checkpoint53c_post, checkpoint53d_post, checkpoint48a_post, checkpoint46n_post, checkpoint51f_pre, checkpoint46d_pre, checkpoint48e_post, checkpoint46e_post, checkpoint48h_post, checkpoint50c_pre, checkpoint44g_post, branchpoint-genmake2, checkpoint46h_pre, checkpoint44h_post, checkpoint50b_pre, checkpoint52j_pre, checkpoint46e_pre, branch-netcdf, checkpoint50d_pre, checkpoint45d_post, checkpoint51r_post, checkpoint47i_post, checkpoint52b_pre, checkpoint52n_post, checkpoint46l_pre, checkpoint46j_pre, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint47h_post, checkpoint48c_post, checkpoint46l_post, checkpoint51e_post, checkpoint51b_post, checkpoint46, checkpoint51l_pre, checkpoint52m_post, checkpoint51c_post, checkpoint53a_post, checkpoint48, checkpoint49, checkpoint44f_post, checkpoint47b_post, checkpoint53b_post, checkpoint51o_post, checkpoint48g_post, checkpoint51q_post, checkpoint52l_post, checkpoint52k_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, checkpoint50d_post, checkpoint52d_post, checkpoint46g_pre, checkpoint51b_pre, checkpoint52a_post, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, checkpoint52f_post, checkpoint52c_post, checkpoint46m_post, checkpoint51h_pre, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint51g_post, ecco_c52_e35, checkpoint46b_post, checkpoint51f_post, checkpoint46d_post, checkpoint48b_post, checkpoint50b_post, checkpoint46g_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint46c_pre, checkpoint50f_pre, checkpoint52a_pre, checkpoint47d_pre, checkpoint51d_post, checkpoint48c_pre, checkpoint46i_post, checkpoint51m_post, checkpoint51t_post, checkpoint53d_pre, checkpoint47, checkpoint46c_post, checkpoint50h_post, checkpoint52i_post, checkpoint51a_post, checkpoint45, checkpoint46h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, checkpoint51i_pre, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post
Branch point for: netcdf-sm0, branch-genmake2, branch-nonh, tg2-branch, checkpoint51n_branch, branch-exfmods-curt
Changes since 1.2: +50 -23 lines 
o parameter Shap_noSlip replace CPP option NO_SLIP_SHAP
o add filter time scale (missing in some Shap_filt S/R)
o add exchange at the end (missing in some Shapi_filt S/R)
o working arrays (in common block SHAP_FILT.h) become argument
  of Shap_filt S/R.  => Enable to filter 2D fields.
1 jmc 1.3 C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/shap_filt/Attic/shap_filt_tracer_s2g.F,v 1.3 2002/03/04 01:32:55 jmc Exp $
2     C $Name: $
3 adcroft 1.2
4     #include "SHAP_FILT_OPTIONS.h"
5 jmc 1.3
6     CBOP
7     C !ROUTINE: SHAP_FILT_TRACER_S2G
8     C !INTERFACE:
9     SUBROUTINE SHAP_FILT_TRACER_S2G(
10     U field, tmpFld,
11     I kSize, myTime, myThid )
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | S/R SHAP_FILT_TRACER_S2G
15     C | o Applies Shapiro filter to tracer field (cell center).
16     C | o use filtering function "S2" = [1 - (d_xx+d_yy)^n]
17     C | with grid spacing (physical space 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_S2G
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 jmc 1.3 CEOP
51 adcroft 1.2
52     IF (nShapT.gt.0) THEN
53    
54     DO bj=myByLo(myThid),myByHi(myThid)
55     DO bi=myBxLo(myThid),myBxHi(myThid)
56 jmc 1.3 DO K=1,kSize
57     DO J=1-OLy,sNy+OLy
58     DO I=1-OLx,sNx+OLx
59 adcroft 1.2 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
60     ENDDO
61     ENDDO
62     ENDDO
63     ENDDO
64     ENDDO
65    
66    
67     C ( d_xx +d_yy )^n tmpFld
68    
69     DO N=1,nShapT
70    
71 jmc 1.3 IF (kSize.EQ.Nr) THEN
72     _EXCH_XYZ_R8( tmpFld, myThid )
73     ELSE
74     _EXCH_XY_R8( tmpFld, myThid )
75     ENDIF
76 adcroft 1.2
77     DO bj=myByLo(myThid),myByHi(myThid)
78     DO bi=myBxLo(myThid),myBxHi(myThid)
79 jmc 1.3 DO K=1,kSize
80 adcroft 1.2
81     DO J=1,sNy
82     DO I=1,sNx
83     tmpGrd(i,j) = -0.125*(
84     & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
85     & *_hFacW(i+1,j,k,bi,bj)
86     & *DYG(i+1,j,bi,bj)
87     & *recip_DXC(i+1,j,bi,bj)
88     & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
89     & *_hFacW( i ,j,k,bi,bj)
90     & *DYG( i ,j,bi,bj)
91     & *recip_DXC( i ,j,bi,bj)
92     & +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
93     & *_hFacS(i,j+1,k,bi,bj)
94     & *DXG(i,j+1,bi,bj)
95     & *recip_DYC(i,j+1,bi,bj)
96     & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
97     & *_hFacS(i, j ,k,bi,bj)
98     & *DXG(i, j ,bi,bj)
99     & *recip_DYC(i, j ,bi,bj)
100     & )*recip_hFacC(i,j,k,bi,bj)
101     ENDDO
102     ENDDO
103    
104     IF (Shap_TrLength.EQ.0.) THEN
105     DO J=1,sNy
106     DO I=1,sNx
107     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
108     ENDDO
109     ENDDO
110     ELSE
111     DO J=1,sNy
112     DO I=1,sNx
113     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
114     & *recip_rA(i,j,bi,bj)
115     & *Shap_TrLength*Shap_TrLength
116     ENDDO
117     ENDDO
118     ENDIF
119    
120     ENDDO
121     ENDDO
122     ENDDO
123    
124     ENDDO
125    
126 jmc 1.3 C F <- [1 - (d_xx+d_yy)^n *deltaT/tau].F
127 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
128     DO bi=myBxLo(myThid),myBxHi(myThid)
129 jmc 1.3 DO K=1,kSize
130 adcroft 1.2 DO J=1,sNy
131     DO I=1,sNx
132     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
133     & -deltaTtracer/Shap_Trtau*tmpFld(i,j,k,bi,bj)
134     ENDDO
135     ENDDO
136     ENDDO
137     ENDDO
138     ENDDO
139    
140 jmc 1.3 IF (kSize.EQ.Nr) THEN
141     _EXCH_XYZ_R8( field, myThid )
142     ELSEIF (kSize.EQ.1) THEN
143     _EXCH_XY_R8( field, myThid )
144     ELSE
145     STOP 'S/R SHAP_FILT_TRACER_S4: kSize is wrong'
146     ENDIF
147 adcroft 1.2
148     ENDIF
149     #endif /* ALLOW_SHAP_FILT */
150    
151     RETURN
152     END
  ViewVC Help
Powered by ViewVC 1.1.22