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

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

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

revision 1.2.6.1 by adcroft, Tue Feb 26 16:04:49 2002 UTC revision 1.13 by jmc, Fri Mar 24 23:51:14 2017 UTC
# Line 22  C !USES: =============================== Line 22  C !USES: ===============================
22  #include "PARAMS.h"  #include "PARAMS.h"
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24  #include "GRID.h"  #include "GRID.h"
 #ifdef ALLOW_SHAP_FILT  
25  #include "SHAP_FILT.h"  #include "SHAP_FILT.h"
 #endif  
26    
27  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
28  C  myTime               :: current time  C  myTime               :: current time
# Line 42  C sFld                  :: input and fil Line 40  C sFld                  :: input and fil
40    
41  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
42    
43  C !LOCAL VARIABLES: ====================================================        LOGICAL  DIFFERENT_MULTIPLE
44  C none        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*(10) suff
54  CEOP  CEOP
55    
56        IF (nShapT.GT.0) THEN        IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
57    
58    C-    Apply Exchanges on Input field, before the filter (but not after):
59            exchInOut = 1
60    C-    Apply Exchanges on Output field, after the filter (but not before):
61            IF ( implicitIntGravWave ) exchInOut = 2
62    
63  #ifdef USE_OLD_SHAPIRO_FILTERS  #ifdef USE_OLD_SHAPIRO_FILTERS
64    
65          IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )          IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
66          IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )          IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
67    
68          DO bj=myByLo(myThid),myByHi(myThid)          DO bj=myByLo(myThid),myByHi(myThid)
69           DO bi=myBxLo(myThid),myBxHi(myThid)           DO bi=myBxLo(myThid),myBxHi(myThid)
70            DO k=1, Nr            DO k=1, Nr
71              IF ( tempStepping )              IF ( tempStepping )
72       &       CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )       &       CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
73              IF ( saltStepping )              IF ( saltStepping )
74       &       CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )       &       CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
75            ENDDO            ENDDO
76           ENDDO           ENDDO
77          ENDDO          ENDDO
78    
79          IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )          IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
80          IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )          IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
81    
82  #else  #else
83    
84          IF ( tempStepping .AND. nShapT.GT.0) THEN          IF ( tempStepping .AND. nShapT.GT.0) THEN
85            IF (Shap_funct.EQ.1) THEN            IF (Shap_funct.EQ.1) THEN
86              CALL SHAP_FILT_TRACER_S1(              CALL SHAP_FILT_TRACER_S1(
87       U           tFld,       U           tFld, Shap_tmpFld1,
88       I           myTime, myThid )       I           nShapT, Nr, myTime, myThid )
89            ELSEIF (Shap_funct.EQ.2) THEN            ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
90         &                            .OR. Shap_funct.EQ.21) THEN
91              CALL SHAP_FILT_TRACER_S2(              CALL SHAP_FILT_TRACER_S2(
92       U           tFld,       U           tFld, Shap_tmpFld1,
93       I           myTime, myThid )       I           nShapT, exchInOut, Nr, myTime, myIter, myThid )
94            ELSEIF (Shap_funct.EQ.4) THEN            ELSEIF (Shap_funct.EQ.4) THEN
95              CALL SHAP_FILT_TRACER_S4(              CALL SHAP_FILT_TRACER_S4(
96       U           tFld,       U           tFld, Shap_tmpFld1,
97       I           myTime, myThid )       I           nShapT, Nr, myTime, myThid )
98            ELSEIF (Shap_funct.EQ.20) THEN  c         ELSEIF (Shap_funct.EQ.20) THEN
99              CALL SHAP_FILT_TRACER_S2G(  c           CALL SHAP_FILT_TRACER_S2G(
100       U           tFld,  c    U           tFld, Shap_tmpFld1,
101       I           myTime, myThid )  c    I           nShapT, Nr, myTime, myThid )
102            ELSE            ELSE
103             STOP 'SHAP_FILT_APPLY: Ooops! Bad Shap_funct in T block'             STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
104              ENDIF
105    
106    C-----    Diagnostic of Shapiro Filter effect on temperature :
107    C         Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
108    C               is directly proportional to Delta-Tr due to the Filter
109              IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
110         &     DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
111         &       ) THEN
112               _BARRIER
113               IF ( rwSuffixType.EQ.0 ) THEN
114                 WRITE(suff,'(I10.10)') myIter
115               ELSE
116                 CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
117               ENDIF
118               CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
119         &                            myIter, myThid)
120               _BARRIER
121            ENDIF            ENDIF
122    
123    #ifdef ALLOW_DIAGNOSTICS
124              IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
125         &                         .AND. useDiagnostics ) THEN
126                CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
127         &                                                  0,1,1,myThid)
128              ENDIF
129    #endif /* ALLOW_DIAGNOSTICS */
130    
131          ENDIF          ENDIF
132    
133          IF ( saltStepping .AND. nShapT.GT.0) THEN          IF ( saltStepping .AND. nShapS.GT.0) THEN
134            IF (Shap_funct.EQ.1) THEN            IF (Shap_funct.EQ.1) THEN
135              CALL SHAP_FILT_TRACER_S1(              CALL SHAP_FILT_TRACER_S1(
136       U           sFld,       U           sFld, Shap_tmpFld1,
137       I           myTime, myThid )       I           nShapS, Nr, myTime, myThid )
138            ELSEIF (Shap_funct.EQ.2) THEN            ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
139         &                            .OR. Shap_funct.EQ.21) THEN
140              CALL SHAP_FILT_TRACER_S2(              CALL SHAP_FILT_TRACER_S2(
141       U           sFld,       U           sFld, Shap_tmpFld1,
142       I           myTime, myThid )       I           nShapS, exchInOut, Nr, myTime, myIter, myThid )
143            ELSEIF (Shap_funct.EQ.4) THEN            ELSEIF (Shap_funct.EQ.4) THEN
144              CALL SHAP_FILT_TRACER_S4(              CALL SHAP_FILT_TRACER_S4(
145       U           sFld,       U           sFld, Shap_tmpFld1,
146       I           myTime, myThid )       I           nShapS, Nr, myTime, myThid )
147            ELSEIF (Shap_funct.EQ.20) THEN  c         ELSEIF (Shap_funct.EQ.20) THEN
148              CALL SHAP_FILT_TRACER_S2G(  c           CALL SHAP_FILT_TRACER_S2G(
149       U           sFld,  c    U           sFld, Shap_tmpFld1,
150       I           myTime, myThid )  c    I           nShapS, Nr, myTime, myThid )
151            ELSE            ELSE
152             STOP 'SHAP_FILT_APPLY: Ooops! Bad Shap_funct in S block'             STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
153              ENDIF
154    
155    C-----    Diagnostic of Shapiro Filter effect on salinity :
156    C         Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
157    C               is directly proportional to Delta-Tr due to the Filter
158              IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
159         &     DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
160         &       ) THEN
161               _BARRIER
162               IF ( rwSuffixType.EQ.0 ) THEN
163                 WRITE(suff,'(I10.10)') myIter
164               ELSE
165                 CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
166               ENDIF
167               CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
168         &                            myIter, myThid)
169               _BARRIER
170              ENDIF
171    
172    #ifdef ALLOW_DIAGNOSTICS
173              IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
174         &                         .AND. useDiagnostics ) THEN
175                CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
176         &                                                  0,1,1,myThid)
177            ENDIF            ENDIF
178    #endif /* ALLOW_DIAGNOSTICS */
179    
180          ENDIF          ENDIF
181    
182  #endif /* USE_OLD_SHAPIRO_FILTERS */  #endif /* USE_OLD_SHAPIRO_FILTERS */
Legend:
Removed from v.1.2.6.1  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22