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

Annotation of /MITgcm/pkg/shap_filt/shap_filt_tracerold.F

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

Revision 1.1.2.1 - (hide annotations) (download)
Tue Jan 23 15:58:59 2001 UTC (23 years, 3 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: +104 -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 adcroft 1.1.2.1 C $Header: $
2    
3     #include "SHAP_FILT_OPTIONS.h"
4    
5     SUBROUTINE SHAP_FILT_TRACEROLD(
6     U field,
7     I bi, bj, K, myCurrentTime, myThid )
8     C /==========================================================\
9     C | S/R SHAP_FILT_TRACER |
10     C | Applies Shapiro filter to tracer field over one XY slice |
11     C | of one tile at a time. |
12     C \==========================================================/
13     IMPLICIT NONE
14    
15     C == Global variables ===
16     #include "SIZE.h"
17     #include "EEPARAMS.h"
18     #include "PARAMS.h"
19     #include "GRID.h"
20    
21     C == Routine arguments
22     INTEGER myThid
23     _RL myCurrentTime
24     INTEGER bi, bj, K
25     _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26    
27     #ifdef ALLOW_SHAP_FILT
28    
29     C == Local variables ==
30     _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
31     _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
32     INTEGER I,J,N,N1,N2
33    
34     DO J=1-OLy,sNy+OLy
35     DO I=1-OLx,sNx+OLx
36     tmpFldX(i,j,1) = field(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 ,j,N1) )
48     & *_maskW(i+1,j,k,bi,bj)
49     & -( tmpFldX( i ,j,N1)-tmpFldX(i-1,j,N1) )
50     & *_maskW(i,j,k,bi,bj) )
51     ENDDO
52     ENDDO
53     ENDDO
54    
55     #ifdef SEQUENTIAL_2D_SHAP
56     DO J=1-OLy,sNy+OLy
57     DO I=1-OLx,sNx+OLx
58     tmpFldX(i,j,N2) = field(i,j,k,bi,bj) - tmpFldX(i,j,N2)
59     tmpFldY(i,j,1) = tmpFldX(i,j,N2)
60     ENDDO
61     ENDDO
62     #else
63     DO J=1-OLy,sNy+OLy
64     DO I=1-OLx,sNx+OLx
65     tmpFldY(i,j,1) = field(i,j,k,bi,bj)
66     ENDDO
67     ENDDO
68     #endif /* SEQUENTIAL_2D_SHAP */
69    
70     C Extract small-scale noise from tmpFldY (delta_jj^n)
71     DO N=1,nShap
72     N1=1+mod(N+1,2)
73     N2=1+mod( N ,2)
74     DO J=1-OLy+1,sNy+OLy-1
75     DO I=1-OLx,sNx+OLx
76     tmpFldY(i,j,N2) = -0.25*(
77     & ( tmpFldY(i,j+1,N1)-tmpFldY(i, j ,N1) )
78     & *_maskS(i,j+1,k,bi,bj)
79     & -( tmpFldY(i, j ,N1)-tmpFldY(i,j-1,N1) )
80     & *_maskS(i,j,k,bi,bj) )
81     ENDDO
82     ENDDO
83     ENDDO
84    
85     C Subtract small-scale noise from field
86     #ifdef SEQUENTIAL_2D_SHAP
87     DO J=1-OLy,sNy+OLy
88     DO I=1-OLx,sNx+OLx
89     field(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
90     ENDDO
91     ENDDO
92     #else
93     DO J=1-OLy,sNy+OLy
94     DO I=1-OLx,sNx+OLx
95     field(i,j,k,bi,bj) = field(i,j,k,bi,bj)
96     & -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
97     ENDDO
98     ENDDO
99     #endif /* SEQUENTIAL_2D_SHAP */
100    
101     #endif /* ALLOW_SHAP_FILT */
102    
103     RETURN
104     END
  ViewVC Help
Powered by ViewVC 1.1.22