pkg/shap_filt/shap_filt_u.F

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