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

Diff of /MITgcm/pkg/shap_filt/shap_filt_readparms.F

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

revision 1.4.2.2 by jmc, Wed Jul 31 21:25:02 2002 UTC revision 1.17 by mlosch, Wed Aug 9 15:23:36 2017 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "SHAP_FILT_OPTIONS.h"  #include "SHAP_FILT_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: SHAP_FILT_READPARMS
8    C     !INTERFACE:
9        SUBROUTINE SHAP_FILT_READPARMS( myThid )        SUBROUTINE SHAP_FILT_READPARMS( myThid )
10  C     /==========================================================\  
11  C     | SUBROUTINE SHAP_FILT_READPARMS                           |  C     !DESCRIPTION: \bv
12  C     | o Routine to initialize Shapiro Filter parameters        |  C     *==========================================================*
13  C     |==========================================================|  C     | SUBROUTINE SHAP_FILT_READPARMS
14  C     \==========================================================/  C     | o Routine to initialize Shapiro Filter parameters
15    C     *==========================================================*
16    C     *==========================================================*
17    C     \ev
18    
19    C     !USES:
20        IMPLICIT NONE        IMPLICIT NONE
21    
22  C     === Global variables ===  C     === Global variables ===
# Line 17  C     === Global variables === Line 25  C     === Global variables ===
25  #include "PARAMS.h"  #include "PARAMS.h"
26  #include "SHAP_FILT.h"  #include "SHAP_FILT.h"
27    
28    C     !INPUT/OUTPUT PARAMETERS:
29  C     === Routine arguments ===  C     === Routine arguments ===
30        INTEGER myThid        INTEGER myThid
31    
32  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
33    
34        NAMELIST /SHAP_PARM01/  C     !LOCAL VARIABLES:
      & Shap_funct, shap_filt_uvStar, shap_filt_TrStagg,  
      &    nShapT,  nShapTrPhys, Shap_Trtau, Shap_TrLength,  
      &    nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength  
   
35  C     === Local variables ===  C     === Local variables ===
36  C     msgBuf      - Informational/error meesage buffer  C     msgBuf     :: Informational/error message buffer
37  C     iUnit       - Work variable for IO unit number  C     iUnit      :: Work variable for IO unit number
38        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
39        INTEGER iUnit        INTEGER iUnit
40    CEOP
41    
42          NAMELIST /SHAP_PARM01/
43         &   Shap_funct, shap_filt_uvStar, shap_filt_TrStagg,
44         &   Shap_alwaysExchUV, Shap_alwaysExchTr,
45         &   nShapT,nShapS, nShapTrPhys, Shap_Trtau, Shap_TrLength,
46         &   nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength,
47         &   Shap_noSlip, Shap_diagFreq
48    
49          IF ( .NOT.useSHAP_FILT ) THEN
50    C-    pkg SHAP_FILT is not used
51            _BEGIN_MASTER(myThid)
52    C-    Track pkg activation status:
53    c        SHAPIsOn = .FALSE.
54    C     print a (weak) warning if data.shap is found
55             CALL PACKAGES_UNUSED_MSG( 'useSHAP_FILT', ' ', 'shap' )
56            _END_MASTER(myThid)
57            RETURN
58          ENDIF
59    
60  C--   SHAP_FILT_READPARMS has been called so we know that  C--   SHAP_FILT_READPARMS has been called so we know that
61  C     the package is active.  C     the package is active.
62  c     SHAPIsOn=.TRUE.  c     SHAPIsOn = .TRUE.
63    
64        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
65    
# Line 50  c     SHAPIsOn=.TRUE. Line 74  c     SHAPIsOn=.TRUE.
74    
75  C--   Default flags and values for Shapiro Filter  C--   Default flags and values for Shapiro Filter
76        Shap_funct = 2        Shap_funct = 2
77        shap_filt_uvStar =.TRUE.        shap_filt_uvStar  = .TRUE.
78        shap_filt_TrStagg=.TRUE.        shap_filt_TrStagg = .TRUE.
79          Shap_alwaysExchUV = .FALSE.
80          Shap_alwaysExchTr = .FALSE.
81        nShapT = 0        nShapT = 0
82          nShapS = -1
83        nShapUV = 0        nShapUV = 0
84        nShapTrPhys = 0        nShapTrPhys = 0
85        nShapUVPhys = 0        nShapUVPhys = 0
86        Shap_Trtau = deltaTtracer        Shap_Trtau = dTtracerLev(1)
87        Shap_TrLength = 0.        Shap_TrLength = 0.
88        Shap_uvtau = deltaTMom        Shap_uvtau = deltaTMom
89        Shap_TrLength = 0.        Shap_TrLength = 0.
90          Shap_noSlip = 0.
91          Shap_diagFreq = diagFreq
92    
93  C--   Read parameters from open data file  C--   Read parameters from open data file
94        READ(UNIT=iUnit,NML=SHAP_PARM01)        READ(UNIT=iUnit,NML=SHAP_PARM01)
95    
96        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
97       &   ' SHAP_FILT_READPARMS: finished reading data.shap'       &   ' SHAP_FILT_READPARMS: finished reading data.shap'
98        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
99       &                    SQUEEZE_RIGHT , 1)       &                    SQUEEZE_RIGHT , 1)
100    
101  C--   Close the open data file  C--   Close the open data file
102    #ifdef SINGLE_DISK_IO
103        CLOSE(iUnit)        CLOSE(iUnit)
104    #else
105          CLOSE(iUnit,STATUS='DELETE')
106    #endif /* SINGLE_DISK_IO */
107    
108    C     for backward compatibility:
109          IF (nShapS.EQ.-1) nShapS = nShapT
110    
111          IF (Shap_funct.EQ.20) THEN
112    C     use shap-funct S2 with nShap_Phys=nShap
113    C     to get exactly the same results as shap-funct S2G.
114            nShapTrPhys = MAX(nShapT,nShapS)
115            nShapUVPhys = nShapUV
116          ENDIF
117    
118          IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4
119         &     .OR. Shap_funct.EQ.21
120         &   ) THEN
121            Shap_alwaysExchUV = .TRUE.
122          ENDIF
123          IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4
124         &   ) THEN
125            Shap_alwaysExchTr = .TRUE.
126          ENDIF
127    
128  C- print out some kee parameters :  C- print out some kee parameters :
129        CALL WRITE_0D_I( Shap_funct, INDEX_NONE,        CALL WRITE_0D_I( Shap_funct, INDEX_NONE,
130       & 'Shap_funct =',       & 'Shap_funct =',
131       & '   /* select Shapiro filter function */')         & '   /* select Shapiro filter function */')
132        CALL WRITE_0D_I( nShapT , INDEX_NONE,        CALL WRITE_0D_I( nShapT , INDEX_NONE,
133       & 'nShapTr =',       & 'nShapT =',
134       & '   /* power of Shapiro filter for Tracers */')         & '   /* power of Shapiro filter for Temperat */')
135          CALL WRITE_0D_I( nShapS , INDEX_NONE,
136         & 'nShapS =',
137         & '   /* power of Shapiro filter for Salinity */')
138        CALL WRITE_0D_I( nShapUV, INDEX_NONE,        CALL WRITE_0D_I( nShapUV, INDEX_NONE,
139       & 'nShapUV =',       & 'nShapUV =',
140       & '   /* power of Shapiro filter for momentum */')         & '   /* power of Shapiro filter for momentum */')
141    
142          CALL WRITE_0D_L( shap_filt_uvStar,  INDEX_NONE,
143         & 'shap_filt_uvStar =',' /* apply filter before Press. Solver */')
144          CALL WRITE_0D_L( shap_filt_TrStagg, INDEX_NONE,
145         & 'shap_filt_TrStagg =',
146         & ' /* filter T,S before calc PhiHyd (staggerTimeStep) */')
147          CALL WRITE_0D_L( Shap_alwaysExchUV, INDEX_NONE,
148         & 'Shap_alwaysExchUV =',' /* always exch(U,V)    nShapUV times*/')
149          CALL WRITE_0D_L( Shap_alwaysExchTr, INDEX_NONE,
150         & 'Shap_alwaysExchTr =',' /* always exch(Tracer) nShapTr times*/')
151    
152        IF (Shap_funct.EQ.2) THEN        IF (Shap_funct.EQ.2) THEN
153         CALL WRITE_0D_I( nShapTrPhys, INDEX_NONE,         CALL WRITE_0D_I( nShapTrPhys, INDEX_NONE,
154       & 'nShapTrPhys =',       & 'nShapTrPhys =',
155       & '   /* power of physical-space filter (Tracer) */')         & '   /* power of physical-space filter (Tracer) */')
156         CALL WRITE_0D_I( nShapUVPhys, INDEX_NONE,         CALL WRITE_0D_I( nShapUVPhys, INDEX_NONE,
157       & 'nShapUVPhys =',       & 'nShapUVPhys =',
158       & '   /* power of physical-space filter (Momentum) */')         & '   /* power of physical-space filter (Momentum) */')
159        ENDIF        ENDIF
160    
161        CALL WRITE_0D_R8( Shap_Trtau, INDEX_NONE,        CALL WRITE_0D_RL( Shap_Trtau, INDEX_NONE,
162       & 'Shap_Trtau =',       & 'Shap_Trtau =',
163       & '   /* time scale of Shapiro filter (Tracer) */')         & '   /* time scale of Shapiro filter (Tracer) */')
164        CALL WRITE_0D_R8( Shap_TrLength, INDEX_NONE,        CALL WRITE_0D_RL( Shap_TrLength, INDEX_NONE,
165       & 'Shap_TrLength =',       & 'Shap_TrLength =',
166       & '   /* Length scale of Shapiro filter (Tracer) */')         & '   /* Length scale of Shapiro filter (Tracer) */')
167        CALL WRITE_0D_R8( Shap_uvtau, INDEX_NONE,        CALL WRITE_0D_RL( Shap_uvtau, INDEX_NONE,
168       & 'Shap_uvtau =',       & 'Shap_uvtau =',
169       & '   /* time scale of Shapiro filter (Momentum) */')         & '   /* time scale of Shapiro filter (Momentum) */')
170        CALL WRITE_0D_R8( Shap_uvLength, INDEX_NONE,        CALL WRITE_0D_RL( Shap_uvLength, INDEX_NONE,
171       & 'Shap_uvLength =',       & 'Shap_uvLength =',
172       & '   /* Length scale of Shapiro filter (Momentum) */')         & '   /* Length scale of Shapiro filter (Momentum) */')
173          CALL WRITE_0D_RL( Shap_noSlip, INDEX_NONE,
174         & 'Shap_noSlip =',
175         &  '  /* No-slip parameter (0=Free-slip ; 1=No-slip)*/')
176          CALL WRITE_0D_RL( Shap_diagFreq, INDEX_NONE,
177         & 'Shap_diagFreq =',
178         & '   /* Frequency^-1 for diagnostic output (s)*/')
179    
180    C--   Check the Options :
181    #ifndef USE_OLD_SHAPIRO_FILTERS
182    #ifdef NO_SLIP_SHAP
183    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
184             WRITE(msgBuf,'(2A)') 'SHAP_FILT: CPP-option NO_SLIP_SHAP',
185         &                        ' only in OLD_SHAPIRO S/R ;'
186             CALL PRINT_ERROR( msgBuf , 1)
187             WRITE(msgBuf,'(2A)') ' ==> use parameter Shap_noSlip=1. ',
188         &                        '(in "data.shap") instead'
189             CALL PRINT_ERROR( msgBuf , 1)
190             STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
191    #endif
192    #endif
193    
194        _END_MASTER(myThid)  C--   Check the parameters :
195    
196  C--   Everyone else must wait for the parameters to be loaded        IF ( .NOT.shap_filt_uvStar ) THEN
       _BARRIER  
197    
 C--   Check the parameters :  
   
        IF ( .NOT.shap_filt_uvStar ) THEN  
   
198  C- Notes: applying the filter at the end of the time step (after SOLVE_FOR_P)  C- Notes: applying the filter at the end of the time step (after SOLVE_FOR_P)
199  C    affects the barotropic flow divergence ; this might not be consistent  C    affects the barotropic flow divergence ; this might not be consistent
200  C    with some option of the code.  C    with some option of the code.
201    
202          IF ( rigidLid ) THEN          IF ( rigidLid ) THEN
203           WRITE(msgBuf,'(2A)') 'SHAP_FILT with rigidLid ',           WRITE(msgBuf,'(2A)') 'SHAP_FILT with rigidLid ',
204       &                         'needs shap_filt_uvStar=.true.'       &                         'needs shap_filt_uvStar=.true.'
# Line 131  C    with some option of the code. Line 212  C    with some option of the code.
212       &    'requires to recompute Eta after ==> turn on exactConserv '       &    'requires to recompute Eta after ==> turn on exactConserv '
213           CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)           CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)
214          ENDIF          ENDIF
215    
216         ENDIF                            ENDIF
217    
218    C-    Some Filters / options are not available on CS-grid:
219          IF (useCubedSphereExchange) THEN
220           IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4 ) THEN
221             WRITE(msgBuf,'(2A,I3)') 'SHAP_FILT on CS-grid ',
222         &           'does not work with Shap_funct=', Shap_funct
223             CALL PRINT_ERROR( msgBuf , 1)
224             STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
225           ELSEIF ( Shap_funct.EQ.21 .AND. nShapUV.GT.0
226         &                 .AND. nSx*nSy*nPx*nPy .NE. 6 ) THEN
227             WRITE(msgBuf,'(2A)') 'SHAP_FILT on CS-grid:',
228         &     ' multi-tiles / face not implemented with'
229             CALL PRINT_ERROR( msgBuf , 1)
230             WRITE(msgBuf,'(A,I3,A)') ' Shap_funct=', Shap_funct,
231         &     ' ; => use instead Shap_funct=2 & nShap[]Phys=0'
232             CALL PRINT_ERROR( msgBuf , 1)
233             STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
234           ENDIF
235          ENDIF
236    
237          _END_MASTER(myThid)
238    
239    C--   Everyone else must wait for the parameters to be loaded
240          _BARRIER
241    
242  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
243        RETURN        RETURN
Legend:
Removed from v.1.4.2.2  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22