pkg/shap_filt/shap_filt_readparms.F

aea29c8517 Alis*0001 #include "SHAP_FILT_OPTIONS.h"
                0002
92369167b8 Jean*0003 CBOP
                0004 C     !ROUTINE: SHAP_FILT_READPARMS
                0005 C     !INTERFACE:
aea29c8517 Alis*0006       SUBROUTINE SHAP_FILT_READPARMS( myThid )
92369167b8 Jean*0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE SHAP_FILT_READPARMS
                0011 C     | o Routine to initialize Shapiro Filter parameters
                0012 C     *==========================================================*
                0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
aea29c8517 Alis*0017       IMPLICIT NONE
                0018
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "SHAP_FILT.h"
                0024
92369167b8 Jean*0025 C     !INPUT/OUTPUT PARAMETERS:
aea29c8517 Alis*0026 C     === Routine arguments ===
                0027       INTEGER myThid
                0028
                0029 #ifdef ALLOW_SHAP_FILT
                0030
92369167b8 Jean*0031 C     !LOCAL VARIABLES:
aea29c8517 Alis*0032 C     === Local variables ===
ae4c29e0db Jean*0033 C     msgBuf     :: Informational/error message buffer
                0034 C     iUnit      :: Work variable for IO unit number
aea29c8517 Alis*0035       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0036       INTEGER iUnit
92369167b8 Jean*0037 CEOP
                0038
                0039       NAMELIST /SHAP_PARM01/
                0040      &   Shap_funct, shap_filt_uvStar, shap_filt_TrStagg,
                0041      &   Shap_alwaysExchUV, Shap_alwaysExchTr,
                0042      &   nShapT,nShapS, nShapTrPhys, Shap_Trtau, Shap_TrLength,
                0043      &   nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength,
                0044      &   Shap_noSlip, Shap_diagFreq
aea29c8517 Alis*0045
ae4c29e0db Jean*0046       IF ( .NOT.useSHAP_FILT ) THEN
                0047 C-    pkg SHAP_FILT is not used
                0048         _BEGIN_MASTER(myThid)
                0049 C-    Track pkg activation status:
                0050 c        SHAPIsOn = .FALSE.
                0051 C     print a (weak) warning if data.shap is found
                0052          CALL PACKAGES_UNUSED_MSG( 'useSHAP_FILT', ' ', 'shap' )
                0053         _END_MASTER(myThid)
                0054         RETURN
                0055       ENDIF
                0056
aea29c8517 Alis*0057 C--   SHAP_FILT_READPARMS has been called so we know that
                0058 C     the package is active.
ae4c29e0db Jean*0059 c     SHAPIsOn = .TRUE.
aea29c8517 Alis*0060
                0061       _BEGIN_MASTER(myThid)
                0062
                0063       WRITE(msgBuf,'(A)') ' SHAP_FILT_READPARMS: opening data.shap'
                0064       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0065      &                    SQUEEZE_RIGHT , 1)
                0066
                0067       CALL OPEN_COPY_DATA_FILE(
                0068      I                          'data.shap', 'SHAP_FILT_READPARMS',
                0069      O                          iUnit,
                0070      I                          myThid )
                0071
                0072 C--   Default flags and values for Shapiro Filter
e64f43ca56 Jean*0073       Shap_funct = 2
92369167b8 Jean*0074       shap_filt_uvStar  = .TRUE.
                0075       shap_filt_TrStagg = .TRUE.
                0076       Shap_alwaysExchUV = .FALSE.
                0077       Shap_alwaysExchTr = .FALSE.
aea29c8517 Alis*0078       nShapT = 0
fb09a37055 Jean*0079       nShapS = -1
aea29c8517 Alis*0080       nShapUV = 0
e64f43ca56 Jean*0081       nShapTrPhys = 0
                0082       nShapUVPhys = 0
dfc17c9c63 Jean*0083       Shap_Trtau = dTtracerLev(1)
aea29c8517 Alis*0084       Shap_TrLength = 0.
                0085       Shap_uvtau = deltaTMom
                0086       Shap_TrLength = 0.
d11f474de4 Jean*0087       Shap_noSlip = 0.
00177dc887 Jean*0088       Shap_diagFreq = diagFreq
aea29c8517 Alis*0089
                0090 C--   Read parameters from open data file
                0091       READ(UNIT=iUnit,NML=SHAP_PARM01)
                0092
ae409e69d3 Jean*0093       WRITE(msgBuf,'(A)')
aea29c8517 Alis*0094      &   ' SHAP_FILT_READPARMS: finished reading data.shap'
                0095       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0096      &                    SQUEEZE_RIGHT , 1)
                0097
                0098 C--   Close the open data file
7a77863887 Mart*0099 #ifdef SINGLE_DISK_IO
aea29c8517 Alis*0100       CLOSE(iUnit)
7a77863887 Mart*0101 #else
                0102       CLOSE(iUnit,STATUS='DELETE')
                0103 #endif /* SINGLE_DISK_IO */
d11f474de4 Jean*0104
fb09a37055 Jean*0105 C     for backward compatibility:
                0106       IF (nShapS.EQ.-1) nShapS = nShapT
                0107
ae409e69d3 Jean*0108       IF (Shap_funct.EQ.20) THEN
                0109 C     use shap-funct S2 with nShap_Phys=nShap
                0110 C     to get exactly the same results as shap-funct S2G.
                0111         nShapTrPhys = MAX(nShapT,nShapS)
                0112         nShapUVPhys = nShapUV
                0113       ENDIF
                0114
92369167b8 Jean*0115       IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4
                0116      &     .OR. Shap_funct.EQ.21
e63e6d8a75 Jean*0117      &   ) THEN
92369167b8 Jean*0118         Shap_alwaysExchUV = .TRUE.
                0119       ENDIF
                0120       IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4
                0121      &   ) THEN
                0122         Shap_alwaysExchTr = .TRUE.
                0123       ENDIF
                0124
d11f474de4 Jean*0125 C- print out some kee parameters :
                0126       CALL WRITE_0D_I( Shap_funct, INDEX_NONE,
                0127      & 'Shap_funct =',
ae409e69d3 Jean*0128      & '   /* select Shapiro filter function */')
d11f474de4 Jean*0129       CALL WRITE_0D_I( nShapT , INDEX_NONE,
fb09a37055 Jean*0130      & 'nShapT =',
ae409e69d3 Jean*0131      & '   /* power of Shapiro filter for Temperat */')
fb09a37055 Jean*0132       CALL WRITE_0D_I( nShapS , INDEX_NONE,
                0133      & 'nShapS =',
ae409e69d3 Jean*0134      & '   /* power of Shapiro filter for Salinity */')
d11f474de4 Jean*0135       CALL WRITE_0D_I( nShapUV, INDEX_NONE,
                0136      & 'nShapUV =',
ae409e69d3 Jean*0137      & '   /* power of Shapiro filter for momentum */')
d11f474de4 Jean*0138
92369167b8 Jean*0139       CALL WRITE_0D_L( shap_filt_uvStar,  INDEX_NONE,
                0140      & 'shap_filt_uvStar =',' /* apply filter before Press. Solver */')
                0141       CALL WRITE_0D_L( shap_filt_TrStagg, INDEX_NONE,
                0142      & 'shap_filt_TrStagg =',
                0143      & ' /* filter T,S before calc PhiHyd (staggerTimeStep) */')
                0144       CALL WRITE_0D_L( Shap_alwaysExchUV, INDEX_NONE,
                0145      & 'Shap_alwaysExchUV =',' /* always exch(U,V)    nShapUV times*/')
                0146       CALL WRITE_0D_L( Shap_alwaysExchTr, INDEX_NONE,
                0147      & 'Shap_alwaysExchTr =',' /* always exch(Tracer) nShapTr times*/')
                0148
d11f474de4 Jean*0149       IF (Shap_funct.EQ.2) THEN
                0150        CALL WRITE_0D_I( nShapTrPhys, INDEX_NONE,
                0151      & 'nShapTrPhys =',
ae409e69d3 Jean*0152      & '   /* power of physical-space filter (Tracer) */')
d11f474de4 Jean*0153        CALL WRITE_0D_I( nShapUVPhys, INDEX_NONE,
                0154      & 'nShapUVPhys =',
ae409e69d3 Jean*0155      & '   /* power of physical-space filter (Momentum) */')
d11f474de4 Jean*0156       ENDIF
                0157
4da4b49499 Jean*0158       CALL WRITE_0D_RL( Shap_Trtau, INDEX_NONE,
d11f474de4 Jean*0159      & 'Shap_Trtau =',
ae409e69d3 Jean*0160      & '   /* time scale of Shapiro filter (Tracer) */')
4da4b49499 Jean*0161       CALL WRITE_0D_RL( Shap_TrLength, INDEX_NONE,
d11f474de4 Jean*0162      & 'Shap_TrLength =',
ae409e69d3 Jean*0163      & '   /* Length scale of Shapiro filter (Tracer) */')
4da4b49499 Jean*0164       CALL WRITE_0D_RL( Shap_uvtau, INDEX_NONE,
d11f474de4 Jean*0165      & 'Shap_uvtau =',
ae409e69d3 Jean*0166      & '   /* time scale of Shapiro filter (Momentum) */')
4da4b49499 Jean*0167       CALL WRITE_0D_RL( Shap_uvLength, INDEX_NONE,
d11f474de4 Jean*0168      & 'Shap_uvLength =',
ae409e69d3 Jean*0169      & '   /* Length scale of Shapiro filter (Momentum) */')
4da4b49499 Jean*0170       CALL WRITE_0D_RL( Shap_noSlip, INDEX_NONE,
d11f474de4 Jean*0171      & 'Shap_noSlip =',
ae409e69d3 Jean*0172      &  '  /* No-slip parameter (0=Free-slip ; 1=No-slip)*/')
4da4b49499 Jean*0173       CALL WRITE_0D_RL( Shap_diagFreq, INDEX_NONE,
00177dc887 Jean*0174      & 'Shap_diagFreq =',
ae409e69d3 Jean*0175      & '   /* Frequency^-1 for diagnostic output (s)*/')
d11f474de4 Jean*0176
                0177 C--   Check the Options :
                0178 #ifndef USE_OLD_SHAPIRO_FILTERS
                0179 #ifdef NO_SLIP_SHAP
                0180 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0181          WRITE(msgBuf,'(2A)') 'SHAP_FILT: CPP-option NO_SLIP_SHAP',
                0182      &                        ' only in OLD_SHAPIRO S/R ;'
                0183          CALL PRINT_ERROR( msgBuf , 1)
                0184          WRITE(msgBuf,'(2A)') ' ==> use parameter Shap_noSlip=1. ',
                0185      &                        '(in "data.shap") instead'
                0186          CALL PRINT_ERROR( msgBuf , 1)
                0187          STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
                0188 #endif
                0189 #endif
                0190
05ad780035 Jean*0191 C--   Check the parameters :
ae409e69d3 Jean*0192
984fe7cd3a Jean*0193       IF ( .NOT.shap_filt_uvStar ) THEN
ae409e69d3 Jean*0194
05ad780035 Jean*0195 C- Notes: applying the filter at the end of the time step (after SOLVE_FOR_P)
                0196 C    affects the barotropic flow divergence ; this might not be consistent
                0197 C    with some option of the code.
ae409e69d3 Jean*0198
05ad780035 Jean*0199         IF ( rigidLid ) THEN
                0200          WRITE(msgBuf,'(2A)') 'SHAP_FILT with rigidLid ',
                0201      &                         'needs shap_filt_uvStar=.true.'
                0202          CALL PRINT_ERROR( msgBuf , 1)
                0203          STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
                0204         ELSEIF ( .NOT.exactConserv ) THEN
                0205          WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ',
                0206      &    'applying Filter after SOLVE_FOR_P (shap_filt_uvStar=FALSE)'
1a18fc3009 Jean*0207          CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)
05ad780035 Jean*0208          WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ',
                0209      &    'requires to recompute Eta after ==> turn on exactConserv '
1a18fc3009 Jean*0210          CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)
05ad780035 Jean*0211         ENDIF
ae409e69d3 Jean*0212
                0213       ENDIF
984fe7cd3a Jean*0214
                0215 C-    Some Filters / options are not available on CS-grid:
                0216       IF (useCubedSphereExchange) THEN
                0217        IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4 ) THEN
                0218          WRITE(msgBuf,'(2A,I3)') 'SHAP_FILT on CS-grid ',
                0219      &           'does not work with Shap_funct=', Shap_funct
                0220          CALL PRINT_ERROR( msgBuf , 1)
                0221          STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
                0222        ELSEIF ( Shap_funct.EQ.21 .AND. nShapUV.GT.0
                0223      &                 .AND. nSx*nSy*nPx*nPy .NE. 6 ) THEN
                0224          WRITE(msgBuf,'(2A)') 'SHAP_FILT on CS-grid:',
                0225      &     ' multi-tiles / face not implemented with'
                0226          CALL PRINT_ERROR( msgBuf , 1)
                0227          WRITE(msgBuf,'(A,I3,A)') ' Shap_funct=', Shap_funct,
                0228      &     ' ; => use instead Shap_funct=2 & nShap[]Phys=0'
                0229          CALL PRINT_ERROR( msgBuf , 1)
                0230          STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
ae409e69d3 Jean*0231        ENDIF
                0232       ENDIF
984fe7cd3a Jean*0233
                0234       _END_MASTER(myThid)
                0235
                0236 C--   Everyone else must wait for the parameters to be loaded
                0237       _BARRIER
05ad780035 Jean*0238
aea29c8517 Alis*0239 #endif /* ALLOW_SHAP_FILT */
                0240       RETURN
                0241       END