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

Contents of /MITgcm/pkg/shap_filt/shap_filt_u.F

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

Revision 1.1.2.1 - (show annotations) (download)
Tue Jan 23 15:58:59 2001 UTC (23 years, 4 months ago) by adcroft
Branch: branch-atmos-merge
CVS Tags: branch-atmos-merge-shapiro, branch-atmos-merge-freeze, branch-atmos-merge-zonalfilt
Changes since 1.1: +114 -0 lines 
Added Shapiro filters.
 o this is "quasi-" packaged
   - code resides in pkg/shap_filt
   - does not use it's own data file or _init methods
     since it only uses one parameter
   - the code control is via pkg/shap_filt/SHAP_FILT_OPTIONS.h
 o two versions are available
   - original form written for the UV-exact atmosphere
   - a more general, less efficient form that will work on the cubed sphere
   The latter use exhcanges inside the routine while the former assumes
   the overlaps are upto date and are wide enough.
1 C $Header: $
2
3 #include "SHAP_FILT_OPTIONS.h"
4
5 SUBROUTINE SHAP_FILT_U(uVel,bi,bj,K,myCurrentTime,myThid)
6 C /==========================================================\
7 C | S/R SHAP_FILT_U |
8 C | Applies Shapiro filter to U field over one XY slice |
9 C | of one tile at a time. |
10 C \==========================================================/
11 IMPLICIT NONE
12
13 C == Global variables ===
14 #include "SIZE.h"
15 #include "EEPARAMS.h"
16 #include "PARAMS.h"
17 #include "GRID.h"
18
19 C == Routine arguments
20 _RL uVel(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
21 INTEGER myThid
22 _RL myCurrentTime
23 INTEGER bi, bj, K
24
25 #ifdef ALLOW_SHAP_FILT
26
27 C == Local variables ==
28 _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
29 _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
30 _RS maskZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
31 INTEGER I,J,N,N1,N2
32
33 DO J=1-OLy,sNy+OLy
34 DO I=1-OLx,sNx+OLx
35 tmpFldX(i,j,1) = uVel(i,j,k,bi,bj)
36 & *_maskW(i,j,k,bi,bj)
37 ENDDO
38 ENDDO
39
40 C Extract small-scale noise from tmpFldX (delta_ii^n)
41 DO N=1,nShap
42 N1=1+mod(N+1,2)
43 N2=1+mod( N ,2)
44 DO J=1-OLy,sNy+OLy
45 DO I=1-OLx+1,sNx+OLx-1
46 tmpFldX(i,j,N2) = -0.25*(
47 & tmpFldX(i-1,j,N1) + tmpFldX(i+1,j,N1)
48 & - 2.*tmpFldX(i,j,N1)
49 & )*_maskW(i,j,k,bi,bj)
50 ENDDO
51 ENDDO
52 ENDDO
53
54 C Create temporary Zeta mask (accounting for thin walls)
55 DO J=1-OLy,sNy+OLy
56 DO I=1-OLx+1,sNx+OLx
57 maskZ(i,j) = _maskS(i-1,j,k,bi,bj)
58 & *_maskS( i ,j,k,bi,bj)
59 ENDDO
60 ENDDO
61
62 #ifdef SEQUENTIAL_2D_SHAP
63 DO J=1-OLy,sNy+OLy
64 DO I=1-OLx,sNx+OLx
65 tmpFldX(i,j,N2) = uVel(i,j,k,bi,bj) - tmpFldX(i,j,N2)
66 tmpFldY(i,j,1) = tmpFldX(i,j,N2)
67 ENDDO
68 ENDDO
69 #else
70 DO J=1-OLy,sNy+OLy
71 DO I=1-OLx,sNx+OLx
72 tmpFldY(i,j,1) = uVel(i,j,k,bi,bj)
73 & *_maskW(i,j,k,bi,bj)
74 ENDDO
75 ENDDO
76 #endif /* SEQUENTIAL_2D_SHAP */
77
78 C Extract small-scale noise from tmpFldY (delta_jj^n)
79 DO N=1,nShap
80 N1=1+mod(N+1,2)
81 N2=1+mod( N ,2)
82 DO J=1-OLy+1,sNy+OLy-1
83 DO I=1-OLx+1,sNx+OLx
84 tmpFldY(i,j,N2) = -0.25*(
85 & (tmpFldY(i,j+1,N1)-tmpFldY(i, j ,N1))*maskZ(i,j+1)
86 & -(tmpFldY(i, j ,N1)-tmpFldY(i,j-1,N1))*maskZ(i, j )
87 #ifdef NO_SLIP_SHAP
88 & -2.*(2.-maskZ(i,j)-maskZ(i,j+1))*tmpFldY(i,j,N1)
89 #endif
90 & )*_maskW(i,j,k,bi,bj)
91 ENDDO
92 ENDDO
93 ENDDO
94
95 C Subtract small-scale noise from field
96 #ifdef SEQUENTIAL_2D_SHAP
97 DO J=1-OLy,sNy+OLy
98 DO I=1-OLx,sNx+OLx
99 uVel(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
100 ENDDO
101 ENDDO
102 #else
103 DO J=1-OLy,sNy+OLy
104 DO I=1-OLx,sNx+OLx
105 uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)
106 & -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
107 ENDDO
108 ENDDO
109 #endif /* SEQUENTIAL_2D_SHAP */
110
111 #endif /* ALLOW_SHAP_FILT */
112
113 RETURN
114 END
  ViewVC Help
Powered by ViewVC 1.1.22