forked from darwinproject/darwin3
-
Notifications
You must be signed in to change notification settings - Fork 1
/
shap_filt_apply_ts.F
186 lines (157 loc) · 6.19 KB
/
shap_filt_apply_ts.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
#include "SHAP_FILT_OPTIONS.h"
CBOP
C !ROUTINE: SHAP_FILT_APPLY_TS
C !INTERFACE: ==========================================================
SUBROUTINE SHAP_FILT_APPLY_TS(
U tFld, sFld,
I myTime, myIter, myThid )
C !DESCRIPTION:
C Apply a Shapiro filter on active tracers tFld & sFld
C !USES: ===============================================================
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "SHAP_FILT.h"
C !INPUT PARAMETERS: ===================================================
C myTime :: current time
C myIter :: iteration number
C myThid :: thread number
_RL myTime
INTEGER myIter
INTEGER myThid
C !INPUT/OUTPUT PARAMETERS: ============================================
C tFld :: input and filtered temperature field
C sFld :: input and filtered salinity field
_RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
_RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
#ifdef ALLOW_SHAP_FILT
LOGICAL DIFFERENT_MULTIPLE
EXTERNAL DIFFERENT_MULTIPLE
C !LOCAL VARIABLES: ====================================================
C == Local variables ==
#ifdef USE_OLD_SHAPIRO_FILTERS
C bi,bj,k :: loop index
INTEGER bi, bj, k
#endif /* USE_OLD_SHAPIRO_FILTERS */
INTEGER exchInOut
CHARACTER*(10) suff
CEOP
IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
C- Apply Exchanges on Input field, before the filter (but not after):
exchInOut = 1
C- Apply Exchanges on Output field, after the filter (but not before):
IF ( implicitIntGravWave ) exchInOut = 2
#ifdef USE_OLD_SHAPIRO_FILTERS
IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO k=1, Nr
IF ( tempStepping )
& CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
IF ( saltStepping )
& CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
ENDDO
ENDDO
ENDDO
IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
#else
IF ( tempStepping .AND. nShapT.GT.0) THEN
IF (Shap_funct.EQ.1) THEN
CALL SHAP_FILT_TRACER_S1(
U tFld, Shap_tmpFld1,
I nShapT, Nr, myTime, myThid )
ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
& .OR. Shap_funct.EQ.21) THEN
CALL SHAP_FILT_TRACER_S2(
U tFld, Shap_tmpFld1,
I nShapT, exchInOut, Nr, myTime, myIter, myThid )
ELSEIF (Shap_funct.EQ.4) THEN
CALL SHAP_FILT_TRACER_S4(
U tFld, Shap_tmpFld1,
I nShapT, Nr, myTime, myThid )
c ELSEIF (Shap_funct.EQ.20) THEN
c CALL SHAP_FILT_TRACER_S2G(
c U tFld, Shap_tmpFld1,
c I nShapT, Nr, myTime, myThid )
ELSE
STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
ENDIF
C----- Diagnostic of Shapiro Filter effect on temperature :
C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
C is directly proportional to Delta-Tr due to the Filter
IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
& DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
& ) THEN
_BARRIER
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter
ELSE
CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
ENDIF
CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
& myIter, myThid)
_BARRIER
ENDIF
#ifdef ALLOW_DIAGNOSTICS
IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
& .AND. useDiagnostics ) THEN
CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
& 0,1,1,myThid)
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
ENDIF
IF ( saltStepping .AND. nShapS.GT.0) THEN
IF (Shap_funct.EQ.1) THEN
CALL SHAP_FILT_TRACER_S1(
U sFld, Shap_tmpFld1,
I nShapS, Nr, myTime, myThid )
ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
& .OR. Shap_funct.EQ.21) THEN
CALL SHAP_FILT_TRACER_S2(
U sFld, Shap_tmpFld1,
I nShapS, exchInOut, Nr, myTime, myIter, myThid )
ELSEIF (Shap_funct.EQ.4) THEN
CALL SHAP_FILT_TRACER_S4(
U sFld, Shap_tmpFld1,
I nShapS, Nr, myTime, myThid )
c ELSEIF (Shap_funct.EQ.20) THEN
c CALL SHAP_FILT_TRACER_S2G(
c U sFld, Shap_tmpFld1,
c I nShapS, Nr, myTime, myThid )
ELSE
STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
ENDIF
C----- Diagnostic of Shapiro Filter effect on salinity :
C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
C is directly proportional to Delta-Tr due to the Filter
IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
& DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
& ) THEN
_BARRIER
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter
ELSE
CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
ENDIF
CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
& myIter, myThid)
_BARRIER
ENDIF
#ifdef ALLOW_DIAGNOSTICS
IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
& .AND. useDiagnostics ) THEN
CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
& 0,1,1,myThid)
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
ENDIF
#endif /* USE_OLD_SHAPIRO_FILTERS */
ENDIF
#endif /* ALLOW_SHAP_FILT */
RETURN
END