/[MITgcm]/MITgcm/pkg/zonal_filt/zonal_filt_nofill.F
ViewVC logotype

Diff of /MITgcm/pkg/zonal_filt/zonal_filt_nofill.F

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

revision 1.1 by adcroft, Wed Jan 24 16:56:07 2001 UTC revision 1.1.2.1 by adcroft, Wed Jan 24 16:56:07 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "ZONAL_FILT_OPTIONS.h"
4    
5          SUBROUTINE ZONAL_FILT_NOFILL(
6         U           field,
7         I           jMin, jMax, kMin, kMax, bi, bj, gridLoc, myThid )
8    C     /==========================================================\
9    C     | S/R ZONAL_FILT_NOFILL                                    |
10    C     | o Apply FFT filter to a latitude circle.                 |
11    C     |   *No fill*                                              |
12    C     \==========================================================/
13          IMPLICIT NONE
14    
15    C     == Global data ==
16    #include "SIZE.h"
17    #include "ZONAL_FILT.h"
18    #include "FFTPACK.h"
19    
20    C     == Routine arguments ==
21    C     jMin - Range of points to filter
22    C     jMax
23    C     kMin
24    C     kMax
25    C     bi
26    C     bj
27    C     myThid  - Thread number of this instance of FILTER_LATCIRC_FFT_APPLY
28    C     field   - Field to filter
29    C     gridLoc - Orientation (U or V) of field.
30          INTEGER myThid
31          INTEGER gridLoc
32    C     Real*8 field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
33          Real*8 field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1,nSx,nSy)
34          INTEGER jMin, jMax, kMin, kMax, bi, bj
35    
36    #ifdef ALLOW_ZONAL_FILT
37    
38    C     == Local data ==
39          Real*8 phi(Nx)
40          INTEGER I, J, K
41    
42          DO k=kMin, kMax
43           DO j=jMin, jMax
44    
45    C     o Copy zonal line of field into local workspace
46            DO i=1,sNx
47             phi(I) = field(i,j,k,bi,bj)
48            ENDDO
49    
50    C     o Forward transform (using specific FFT package)
51    C       CALL R8FFTF( Nx, phi, FFTPACKWS(1,bj) )
52            CALL R8FFTF1( Nx, phi,
53         &    FFTPACKWS1(1,bj), FFTPACKWS2(1,bj),FFTPACKWS3(1,bj) )
54    
55    C     o Apply amplitude filter and normalize
56            IF (gridLoc .EQ. 1) THEN
57             DO i=1, Nx
58              phi(i)=phi(i)*ampFactor(i,j,bi,bj)/float(Nx)
59             ENDDO
60            ELSEIF (gridLoc .EQ. 2) THEN
61             DO i=1, Nx
62              phi(i)=phi(i)*ampFactorV(i,j,bi,bj)/float(Nx)
63             ENDDO
64            ELSE
65             WRITE(0,*) 'Error: gridLoc = ',gridLoc
66             STOP 'Error: gridLoc has illegal value'
67            ENDIF
68    
69    C     o Backward transform (using specific FFT package)
70    C       CALL R8FFTB( Nx, phi, FFTPACKWS(1,bj) )
71            CALL R8FFTB1( Nx, phi,
72         &    FFTPACKWS1(1,bj), FFTPACKWS2(1,bj),FFTPACKWS3(1,bj) )
73    
74    C       o Do periodic wrap around by hand
75            DO i=1-OLx,0
76             field(i,j,k,bi,bj) = phi(sNx+i)
77            ENDDO
78            DO i=1,sNx
79             field(i,j,k,bi,bj) = phi(I)
80            ENDDO
81            DO i=sNx+1,sNx+OLx
82             field(i,j,k,bi,bj) = phi(i-sNx)
83            ENDDO
84    
85           ENDDO
86          ENDDO
87    
88    #endif /* ALLOW_ZONAL_FILT */
89    
90          RETURN
91          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.1
  ViewVC Help
Powered by ViewVC 1.1.22