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

Contents 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.11 - (show annotations) (download)
Tue Sep 9 19:58:27 2008 UTC (15 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61f, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61l, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.10: +1 -5 lines
fix for singleCpuIO & multi-threaded: remove _BEGIN/_END_MASTER between IO S/R call

1 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.10 2006/03/26 22:56:43 jmc Exp $
2 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 LOGICAL DIFFERENT_MULTIPLE
44 EXTERNAL DIFFERENT_MULTIPLE
45
46 C !LOCAL VARIABLES: ====================================================
47 C == Local variables ==
48 #ifdef USE_OLD_SHAPIRO_FILTERS
49 C bi,bj,k :: loop index
50 INTEGER bi, bj, k
51 #endif /* USE_OLD_SHAPIRO_FILTERS */
52 INTEGER exchInOut
53 CHARACTER*(MAX_LEN_MBUF) suff
54
55 CEOP
56
57 IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
58
59 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 #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 IF ( tempStepping )
73 & CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
74 IF ( saltStepping )
75 & 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 IF ( tempStepping .AND. nShapT.GT.0) THEN
86 IF (Shap_funct.EQ.1) THEN
87 CALL SHAP_FILT_TRACER_S1(
88 U tFld, Shap_tmpFld1,
89 I nShapT, Nr, myTime, myThid )
90 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
91 & .OR. Shap_funct.EQ.21) THEN
92 CALL SHAP_FILT_TRACER_S2(
93 U tFld, Shap_tmpFld1,
94 I nShapT, exchInOut, Nr, myTime, myIter, myThid )
95 ELSEIF (Shap_funct.EQ.4) THEN
96 CALL SHAP_FILT_TRACER_S4(
97 U tFld, Shap_tmpFld1,
98 I nShapT, Nr, myTime, myThid )
99 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 ELSE
104 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
105 ENDIF
106
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 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
112 & ) THEN
113 _BARRIER
114 WRITE(suff,'(I10.10)') myIter
115 CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
116 & myIter, myThid)
117 _BARRIER
118 ENDIF
119
120 #ifdef ALLOW_DIAGNOSTICS
121 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
122 & .AND. useDiagnostics ) THEN
123 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
124 & 0,1,1,myThid)
125 ENDIF
126 #endif /* ALLOW_DIAGNOSTICS */
127
128 ENDIF
129
130 IF ( saltStepping .AND. nShapS.GT.0) THEN
131 IF (Shap_funct.EQ.1) THEN
132 CALL SHAP_FILT_TRACER_S1(
133 U sFld, Shap_tmpFld1,
134 I nShapS, Nr, myTime, myThid )
135 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
136 & .OR. Shap_funct.EQ.21) THEN
137 CALL SHAP_FILT_TRACER_S2(
138 U sFld, Shap_tmpFld1,
139 I nShapS, exchInOut, Nr, myTime, myIter, myThid )
140 ELSEIF (Shap_funct.EQ.4) THEN
141 CALL SHAP_FILT_TRACER_S4(
142 U sFld, Shap_tmpFld1,
143 I nShapS, Nr, myTime, myThid )
144 c ELSEIF (Shap_funct.EQ.20) THEN
145 c CALL SHAP_FILT_TRACER_S2G(
146 c U sFld, Shap_tmpFld1,
147 c I nShapS, Nr, myTime, myThid )
148 ELSE
149 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
150 ENDIF
151
152 C----- Diagnostic of Shapiro Filter effect on salinity :
153 C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
154 C is directly proportional to Delta-Tr due to the Filter
155 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
156 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
157 & ) THEN
158 _BARRIER
159 WRITE(suff,'(I10.10)') myIter
160 CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
161 & myIter, myThid)
162 _BARRIER
163 ENDIF
164
165 #ifdef ALLOW_DIAGNOSTICS
166 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
167 & .AND. useDiagnostics ) THEN
168 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
169 & 0,1,1,myThid)
170 ENDIF
171 #endif /* ALLOW_DIAGNOSTICS */
172
173 ENDIF
174
175 #endif /* USE_OLD_SHAPIRO_FILTERS */
176
177 ENDIF
178
179 #endif /* ALLOW_SHAP_FILT */
180
181 RETURN
182 END

  ViewVC Help
Powered by ViewVC 1.1.22