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

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

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

Revision 1.10 - (hide annotations) (download)
Sun Mar 26 22:56:43 2006 UTC (18 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint60, checkpoint61, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint58r_post, checkpoint58n_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post, checkpoint61b, checkpoint61c, checkpoint61a
Changes since 1.9: +10 -4 lines 
fix missing Exch with implicitIntGravWave & Shapiro filter on T,S
 (hard to get it right in all cases and to keep the minimum of Exch)
1 jmc 1.10 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.9 2005/09/27 22:11:06 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "SHAP_FILT_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: SHAP_FILT_APPLY_TS
8    
9     C !INTERFACE: ==========================================================
10     SUBROUTINE SHAP_FILT_APPLY_TS(
11     U tFld, sFld,
12     I myTime, myIter, myThid )
13    
14     C !DESCRIPTION:
15     C Apply a Shapiro filter on active tracers tFld & sFld
16    
17     C !USES: ===============================================================
18     IMPLICIT NONE
19    
20     #include "SIZE.h"
21     #include "EEPARAMS.h"
22     #include "PARAMS.h"
23     #include "DYNVARS.h"
24     #include "GRID.h"
25     #include "SHAP_FILT.h"
26    
27     C !INPUT PARAMETERS: ===================================================
28     C myTime :: current time
29     C myIter :: iteration number
30     C myThid :: thread number
31     _RL myTime
32     INTEGER myIter
33     INTEGER myThid
34    
35     C !INPUT/OUTPUT PARAMETERS: ============================================
36     C tFld :: input and filtered temperature field
37     C sFld :: input and filtered salinity field
38     _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
39     _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
40    
41     #ifdef ALLOW_SHAP_FILT
42    
43 jmc 1.8 LOGICAL DIFFERENT_MULTIPLE
44     EXTERNAL DIFFERENT_MULTIPLE
45 jmc 1.4
46 jmc 1.1 C !LOCAL VARIABLES: ====================================================
47 jmc 1.4 C == Local variables ==
48 jmc 1.3 #ifdef USE_OLD_SHAPIRO_FILTERS
49     C bi,bj,k :: loop index
50     INTEGER bi, bj, k
51     #endif /* USE_OLD_SHAPIRO_FILTERS */
52 jmc 1.10 INTEGER exchInOut
53 jmc 1.4 CHARACTER*(MAX_LEN_MBUF) suff
54 jmc 1.1
55     CEOP
56    
57 jmc 1.5 IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
58 jmc 1.1
59 jmc 1.10 C- Apply Exchanges on Input field, before the filter (but not after):
60     exchInOut = 1
61     C- Apply Exchanges on Output field, after the filter (but not before):
62     IF ( implicitIntGravWave ) exchInOut = 2
63    
64 jmc 1.2 #ifdef USE_OLD_SHAPIRO_FILTERS
65    
66     IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
67     IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
68    
69     DO bj=myByLo(myThid),myByHi(myThid)
70     DO bi=myBxLo(myThid),myBxHi(myThid)
71     DO k=1, Nr
72 jmc 1.9 IF ( tempStepping )
73 jmc 1.2 & CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
74 jmc 1.9 IF ( saltStepping )
75 jmc 1.2 & CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
76     ENDDO
77     ENDDO
78     ENDDO
79    
80     IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
81     IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
82    
83     #else
84    
85 jmc 1.1 IF ( tempStepping .AND. nShapT.GT.0) THEN
86     IF (Shap_funct.EQ.1) THEN
87     CALL SHAP_FILT_TRACER_S1(
88 jmc 1.3 U tFld, Shap_tmpFld1,
89 jmc 1.5 I nShapT, Nr, myTime, myThid )
90 jmc 1.9 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
91     & .OR. Shap_funct.EQ.21) THEN
92 jmc 1.1 CALL SHAP_FILT_TRACER_S2(
93 jmc 1.3 U tFld, Shap_tmpFld1,
94 jmc 1.10 I nShapT, exchInOut, Nr, myTime, myIter, myThid )
95 jmc 1.1 ELSEIF (Shap_funct.EQ.4) THEN
96     CALL SHAP_FILT_TRACER_S4(
97 jmc 1.3 U tFld, Shap_tmpFld1,
98 jmc 1.5 I nShapT, Nr, myTime, myThid )
99 jmc 1.9 c ELSEIF (Shap_funct.EQ.20) THEN
100     c CALL SHAP_FILT_TRACER_S2G(
101     c U tFld, Shap_tmpFld1,
102     c I nShapT, Nr, myTime, myThid )
103 jmc 1.1 ELSE
104 jmc 1.3 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
105 jmc 1.1 ENDIF
106 jmc 1.4
107     C----- Diagnostic of Shapiro Filter effect on temperature :
108     C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
109     C is directly proportional to Delta-Tr due to the Filter
110     IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
111 jmc 1.8 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
112 jmc 1.4 & ) THEN
113     _BARRIER
114     _BEGIN_MASTER( myThid )
115     WRITE(suff,'(I10.10)') myIter
116     CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
117     & myIter, myThid)
118     _END_MASTER( myThid )
119     _BARRIER
120     ENDIF
121    
122 jmc 1.6 #ifdef ALLOW_DIAGNOSTICS
123     IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
124     & .AND. useDiagnostics ) THEN
125     CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
126     & 0,1,1,myThid)
127     ENDIF
128     #endif /* ALLOW_DIAGNOSTICS */
129    
130 jmc 1.1 ENDIF
131 jmc 1.2
132 jmc 1.9 IF ( saltStepping .AND. nShapS.GT.0) THEN
133 jmc 1.1 IF (Shap_funct.EQ.1) THEN
134     CALL SHAP_FILT_TRACER_S1(
135 jmc 1.3 U sFld, Shap_tmpFld1,
136 jmc 1.5 I nShapS, Nr, myTime, myThid )
137 jmc 1.9 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
138     & .OR. Shap_funct.EQ.21) THEN
139 jmc 1.1 CALL SHAP_FILT_TRACER_S2(
140 jmc 1.3 U sFld, Shap_tmpFld1,
141 jmc 1.10 I nShapS, exchInOut, Nr, myTime, myIter, myThid )
142 jmc 1.1 ELSEIF (Shap_funct.EQ.4) THEN
143     CALL SHAP_FILT_TRACER_S4(
144 jmc 1.3 U sFld, Shap_tmpFld1,
145 jmc 1.5 I nShapS, Nr, myTime, myThid )
146 jmc 1.9 c ELSEIF (Shap_funct.EQ.20) THEN
147     c CALL SHAP_FILT_TRACER_S2G(
148     c U sFld, Shap_tmpFld1,
149     c I nShapS, Nr, myTime, myThid )
150 jmc 1.1 ELSE
151 jmc 1.3 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
152 jmc 1.1 ENDIF
153 jmc 1.4
154     C----- Diagnostic of Shapiro Filter effect on salinity :
155 jmc 1.10 C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
156 jmc 1.4 C is directly proportional to Delta-Tr due to the Filter
157     IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
158 jmc 1.8 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
159 jmc 1.4 & ) THEN
160     _BARRIER
161     _BEGIN_MASTER( myThid )
162     WRITE(suff,'(I10.10)') myIter
163     CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
164     & myIter, myThid)
165     _END_MASTER( myThid )
166     _BARRIER
167     ENDIF
168    
169 jmc 1.6 #ifdef ALLOW_DIAGNOSTICS
170     IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
171     & .AND. useDiagnostics ) THEN
172     CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
173     & 0,1,1,myThid)
174     ENDIF
175     #endif /* ALLOW_DIAGNOSTICS */
176    
177 jmc 1.1 ENDIF
178    
179 jmc 1.2 #endif /* USE_OLD_SHAPIRO_FILTERS */
180    
181 jmc 1.1 ENDIF
182 jmc 1.2
183 jmc 1.1 #endif /* ALLOW_SHAP_FILT */
184    
185     RETURN
186     END
  ViewVC Help
Powered by ViewVC 1.1.22