pkg/shap_filt/shap_filt_tracerold.F

42c525bfb4 Alis*0001 #include "SHAP_FILT_OPTIONS.h"
                0002
                0003       SUBROUTINE SHAP_FILT_TRACEROLD(
                0004      U           field,
                0005      I           bi, bj, K, myCurrentTime, myThid )
                0006 C     /==========================================================\
                0007 C     | S/R SHAP_FILT_TRACER                                     |
                0008 C     | Applies Shapiro filter to tracer field over one XY slice |
                0009 C     | of one tile at a time.                                   |
                0010 C     \==========================================================/
                0011       IMPLICIT NONE
                0012
                0013 C     == Global variables ===
                0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #include "GRID.h"
aea29c8517 Alis*0018 #include "SHAP_FILT.h"
42c525bfb4 Alis*0019
                0020 C     == Routine arguments
                0021       INTEGER myThid
                0022       _RL     myCurrentTime
                0023       INTEGER bi, bj, K
                0024       _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0025
                0026 #ifdef ALLOW_SHAP_FILT
                0027
                0028 C     == Local variables ==
                0029       _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
                0030       _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
                0031       INTEGER I,J,N,N1,N2
                0032
                0033       DO J=1-OLy,sNy+OLy
                0034        DO I=1-OLx,sNx+OLx
                0035         tmpFldX(i,j,1) = field(i,j,k,bi,bj)
                0036        ENDDO
                0037       ENDDO
                0038
                0039 C     Extract small-scale noise from tmpFldX (delta_ii^n)
aea29c8517 Alis*0040       DO N=1,nShapT
42c525bfb4 Alis*0041        N1=1+mod(N+1,2)
                0042        N2=1+mod( N ,2)
                0043        DO J=1-OLy,sNy+OLy
                0044         DO I=1-OLx+1,sNx+OLx-1
                0045          tmpFldX(i,j,N2) = -0.25*(
                0046      &    ( tmpFldX(i+1,j,N1)-tmpFldX( i ,j,N1) )
                0047      &        *_maskW(i+1,j,k,bi,bj)
                0048      &   -( tmpFldX( i ,j,N1)-tmpFldX(i-1,j,N1) )
                0049      &        *_maskW(i,j,k,bi,bj) )
                0050         ENDDO
                0051        ENDDO
                0052       ENDDO
                0053
                0054 #ifdef SEQUENTIAL_2D_SHAP
                0055       DO J=1-OLy,sNy+OLy
                0056        DO I=1-OLx,sNx+OLx
                0057         tmpFldX(i,j,N2) = field(i,j,k,bi,bj) - tmpFldX(i,j,N2)
                0058         tmpFldY(i,j,1) = tmpFldX(i,j,N2)
                0059        ENDDO
                0060       ENDDO
                0061 #else
                0062       DO J=1-OLy,sNy+OLy
                0063        DO I=1-OLx,sNx+OLx
                0064         tmpFldY(i,j,1) = field(i,j,k,bi,bj)
                0065        ENDDO
                0066       ENDDO
                0067 #endif /* SEQUENTIAL_2D_SHAP */
                0068
                0069 C     Extract small-scale noise from tmpFldY (delta_jj^n)
aea29c8517 Alis*0070       DO N=1,nShapT
42c525bfb4 Alis*0071        N1=1+mod(N+1,2)
                0072        N2=1+mod( N ,2)
                0073        DO J=1-OLy+1,sNy+OLy-1
                0074         DO I=1-OLx,sNx+OLx
                0075          tmpFldY(i,j,N2) = -0.25*(
                0076      &    ( tmpFldY(i,j+1,N1)-tmpFldY(i, j ,N1) )
                0077      &        *_maskS(i,j+1,k,bi,bj)
                0078      &   -( tmpFldY(i, j ,N1)-tmpFldY(i,j-1,N1) )
                0079      &        *_maskS(i,j,k,bi,bj) )
                0080         ENDDO
                0081        ENDDO
                0082       ENDDO
                0083
                0084 C     Subtract small-scale noise from field
                0085 #ifdef SEQUENTIAL_2D_SHAP
                0086       DO J=1-OLy,sNy+OLy
                0087        DO I=1-OLx,sNx+OLx
                0088         field(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
                0089        ENDDO
                0090       ENDDO
                0091 #else
                0092       DO J=1-OLy,sNy+OLy
                0093        DO I=1-OLx,sNx+OLx
                0094         field(i,j,k,bi,bj) = field(i,j,k,bi,bj)
                0095      &    -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
                0096        ENDDO
                0097       ENDDO
                0098 #endif /* SEQUENTIAL_2D_SHAP */
                0099
                0100 #endif /* ALLOW_SHAP_FILT */
                0101
                0102       RETURN
                0103       END