File indexing completed on 2018-03-02 18:43:50 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
49bf680eba Jean*0001 #include "SHAP_FILT_OPTIONS.h"
0002
0003
0004
0005
0006
0007 SUBROUTINE SHAP_FILT_APPLY_TS(
0008 U tFld, sFld,
0009 I myTime, myIter, myThid )
0010
0011
0012
0013
0014
0015 IMPLICIT NONE
0016
0017 #include "SIZE.h"
0018 #include "EEPARAMS.h"
0019 #include "PARAMS.h"
0020 #include "DYNVARS.h"
0021 #include "GRID.h"
0022 #include "SHAP_FILT.h"
0023
0024
0025
0026
0027
0028 _RL myTime
0029 INTEGER myIter
0030 INTEGER myThid
0031
0032
0033
0034
0035 _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0036 _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0037
0038 #ifdef ALLOW_SHAP_FILT
0039
94a46dfe0d Jean*0040 LOGICAL DIFFERENT_MULTIPLE
0041 EXTERNAL DIFFERENT_MULTIPLE
00177dc887 Jean*0042
49bf680eba Jean*0043
d11f474de4 Jean*0044
00177dc887 Jean*0045 #ifdef USE_OLD_SHAPIRO_FILTERS
d11f474de4 Jean*0046
0047 INTEGER bi, bj, k
0048 #endif /* USE_OLD_SHAPIRO_FILTERS */
e93c2e7dac Jean*0049 INTEGER exchInOut
af20bc5e19 Jean*0050 CHARACTER*(10) suff
49bf680eba Jean*0051
0052
fb09a37055 Jean*0053 IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
49bf680eba Jean*0054
e93c2e7dac Jean*0055
0056 exchInOut = 1
0057
0058 IF ( implicitIntGravWave ) exchInOut = 2
0059
36d530816f Jean*0060 #ifdef USE_OLD_SHAPIRO_FILTERS
0061
7163a40534 Jean*0062 IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
0063 IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
36d530816f Jean*0064
0065 DO bj=myByLo(myThid),myByHi(myThid)
0066 DO bi=myBxLo(myThid),myBxHi(myThid)
0067 DO k=1, Nr
ae409e69d3 Jean*0068 IF ( tempStepping )
36d530816f Jean*0069 & CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
ae409e69d3 Jean*0070 IF ( saltStepping )
36d530816f Jean*0071 & CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
0072 ENDDO
0073 ENDDO
0074 ENDDO
0075
7163a40534 Jean*0076 IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
0077 IF ( saltStepping ) _EXCH_XYZ_RL( sFld,myThid )
36d530816f Jean*0078
0079 #else
0080
49bf680eba Jean*0081 IF ( tempStepping .AND. nShapT.GT.0) THEN
0082 IF (Shap_funct.EQ.1) THEN
0083 CALL SHAP_FILT_TRACER_S1(
d11f474de4 Jean*0084 U tFld, Shap_tmpFld1,
fb09a37055 Jean*0085 I nShapT, Nr, myTime, myThid )
ae409e69d3 Jean*0086 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
0087 & .OR. Shap_funct.EQ.21) THEN
49bf680eba Jean*0088 CALL SHAP_FILT_TRACER_S2(
d11f474de4 Jean*0089 U tFld, Shap_tmpFld1,
e93c2e7dac Jean*0090 I nShapT, exchInOut, Nr, myTime, myIter, myThid )
49bf680eba Jean*0091 ELSEIF (Shap_funct.EQ.4) THEN
0092 CALL SHAP_FILT_TRACER_S4(
d11f474de4 Jean*0093 U tFld, Shap_tmpFld1,
fb09a37055 Jean*0094 I nShapT, Nr, myTime, myThid )
ae409e69d3 Jean*0095
0096
0097
0098
49bf680eba Jean*0099 ELSE
d11f474de4 Jean*0100 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
49bf680eba Jean*0101 ENDIF
00177dc887 Jean*0102
0103
0104
0105
0106 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
94a46dfe0d Jean*0107 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
00177dc887 Jean*0108 & ) THEN
0109 _BARRIER
af20bc5e19 Jean*0110 IF ( rwSuffixType.EQ.0 ) THEN
0111 WRITE(suff,'(I10.10)') myIter
0112 ELSE
0113 CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
0114 ENDIF
00177dc887 Jean*0115 CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
0116 & myIter, myThid)
0117 _BARRIER
0118 ENDIF
0119
64e64319fa Jean*0120 #ifdef ALLOW_DIAGNOSTICS
0121 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
0122 & .AND. useDiagnostics ) THEN
0123 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
0124 & 0,1,1,myThid)
0125 ENDIF
0126 #endif /* ALLOW_DIAGNOSTICS */
0127
49bf680eba Jean*0128 ENDIF
36d530816f Jean*0129
ae409e69d3 Jean*0130 IF ( saltStepping .AND. nShapS.GT.0) THEN
49bf680eba Jean*0131 IF (Shap_funct.EQ.1) THEN
0132 CALL SHAP_FILT_TRACER_S1(
d11f474de4 Jean*0133 U sFld, Shap_tmpFld1,
fb09a37055 Jean*0134 I nShapS, Nr, myTime, myThid )
ae409e69d3 Jean*0135 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
0136 & .OR. Shap_funct.EQ.21) THEN
49bf680eba Jean*0137 CALL SHAP_FILT_TRACER_S2(
d11f474de4 Jean*0138 U sFld, Shap_tmpFld1,
e93c2e7dac Jean*0139 I nShapS, exchInOut, Nr, myTime, myIter, myThid )
49bf680eba Jean*0140 ELSEIF (Shap_funct.EQ.4) THEN
0141 CALL SHAP_FILT_TRACER_S4(
d11f474de4 Jean*0142 U sFld, Shap_tmpFld1,
fb09a37055 Jean*0143 I nShapS, Nr, myTime, myThid )
ae409e69d3 Jean*0144
0145
0146
0147
49bf680eba Jean*0148 ELSE
d11f474de4 Jean*0149 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
49bf680eba Jean*0150 ENDIF
00177dc887 Jean*0151
0152
e93c2e7dac Jean*0153
00177dc887 Jean*0154
0155 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
94a46dfe0d Jean*0156 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
00177dc887 Jean*0157 & ) THEN
0158 _BARRIER
af20bc5e19 Jean*0159 IF ( rwSuffixType.EQ.0 ) THEN
0160 WRITE(suff,'(I10.10)') myIter
0161 ELSE
0162 CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
0163 ENDIF
00177dc887 Jean*0164 CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
0165 & myIter, myThid)
0166 _BARRIER
0167 ENDIF
0168
64e64319fa Jean*0169 #ifdef ALLOW_DIAGNOSTICS
0170 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
0171 & .AND. useDiagnostics ) THEN
0172 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
0173 & 0,1,1,myThid)
0174 ENDIF
0175 #endif /* ALLOW_DIAGNOSTICS */
0176
49bf680eba Jean*0177 ENDIF
0178
0179 #endif /* USE_OLD_SHAPIRO_FILTERS */
36d530816f Jean*0180
0181 ENDIF
0182
49bf680eba Jean*0183 #endif /* ALLOW_SHAP_FILT */
0184
0185 RETURN
0186 END