C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_readparms.F,v 1.17 2017/08/09 15:23:36 mlosch Exp $ C $Name: $ #include "SHAP_FILT_OPTIONS.h" CBOP C !ROUTINE: SHAP_FILT_READPARMS C !INTERFACE: SUBROUTINE SHAP_FILT_READPARMS( myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE SHAP_FILT_READPARMS C | o Routine to initialize Shapiro Filter parameters C *==========================================================* C *==========================================================* C \ev C !USES: IMPLICIT NONE C === Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "SHAP_FILT.h" C !INPUT/OUTPUT PARAMETERS: C === Routine arguments === INTEGER myThid #ifdef ALLOW_SHAP_FILT C !LOCAL VARIABLES: C === Local variables === C msgBuf :: Informational/error message buffer C iUnit :: Work variable for IO unit number CHARACTER*(MAX_LEN_MBUF) msgBuf INTEGER iUnit CEOP NAMELIST //SHAP_PARM01 & Shap_funct, shap_filt_uvStar, shap_filt_TrStagg, & Shap_alwaysExchUV, Shap_alwaysExchTr, & nShapT,nShapS, nShapTrPhys, Shap_Trtau, Shap_TrLength, & nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength, & Shap_noSlip, Shap_diagFreq IF ( .NOT.useSHAP_FILT ) THEN C- pkg SHAP_FILT is not used _BEGIN_MASTER(myThid) C- Track pkg activation status: c SHAPIsOn = .FALSE. C print a (weak) warning if data.shap is found CALL PACKAGES_UNUSED_MSG( 'useSHAP_FILT', ' ', 'shap' ) _END_MASTER(myThid) RETURN ENDIF C-- SHAP_FILT_READPARMS has been called so we know that C the package is active. c SHAPIsOn = .TRUE. _BEGIN_MASTER(myThid) WRITE(msgBuf,'(A)') ' SHAP_FILT_READPARMS: opening data.shap' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) CALL OPEN_COPY_DATA_FILE( I 'data.shap', 'SHAP_FILT_READPARMS', O iUnit, I myThid ) C-- Default flags and values for Shapiro Filter Shap_funct = 2 shap_filt_uvStar = .TRUE. shap_filt_TrStagg = .TRUE. Shap_alwaysExchUV = .FALSE. Shap_alwaysExchTr = .FALSE. nShapT = 0 nShapS = -1 nShapUV = 0 nShapTrPhys = 0 nShapUVPhys = 0 Shap_Trtau = dTtracerLev(1) Shap_TrLength = 0. Shap_uvtau = deltaTMom Shap_TrLength = 0. Shap_noSlip = 0. Shap_diagFreq = diagFreq C-- Read parameters from open data file READ(UNIT=iUnit,NML=SHAP_PARM01) WRITE(msgBuf,'(A)') & ' SHAP_FILT_READPARMS: finished reading data.shap' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT , 1) C-- Close the open data file #ifdef SINGLE_DISK_IO CLOSE(iUnit) #else CLOSE(iUnit,STATUS='DELETE') #endif /* SINGLE_DISK_IO */ C for backward compatibility: IF (nShapS.EQ.-1) nShapS = nShapT IF (Shap_funct.EQ.20) THEN C use shap-funct S2 with nShap_Phys=nShap C to get exactly the same results as shap-funct S2G. nShapTrPhys = MAX(nShapT,nShapS) nShapUVPhys = nShapUV ENDIF IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4 & .OR. Shap_funct.EQ.21 & ) THEN Shap_alwaysExchUV = .TRUE. ENDIF IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4 & ) THEN Shap_alwaysExchTr = .TRUE. ENDIF C- print out some kee parameters : CALL WRITE_0D_I( Shap_funct, INDEX_NONE, & 'Shap_funct =', & ' /* select Shapiro filter function */') CALL WRITE_0D_I( nShapT , INDEX_NONE, & 'nShapT =', & ' /* power of Shapiro filter for Temperat */') CALL WRITE_0D_I( nShapS , INDEX_NONE, & 'nShapS =', & ' /* power of Shapiro filter for Salinity */') CALL WRITE_0D_I( nShapUV, INDEX_NONE, & 'nShapUV =', & ' /* power of Shapiro filter for momentum */') CALL WRITE_0D_L( shap_filt_uvStar, INDEX_NONE, & 'shap_filt_uvStar =',' /* apply filter before Press. Solver */') CALL WRITE_0D_L( shap_filt_TrStagg, INDEX_NONE, & 'shap_filt_TrStagg =', & ' /* filter T,S before calc PhiHyd (staggerTimeStep) */') CALL WRITE_0D_L( Shap_alwaysExchUV, INDEX_NONE, & 'Shap_alwaysExchUV =',' /* always exch(U,V) nShapUV times*/') CALL WRITE_0D_L( Shap_alwaysExchTr, INDEX_NONE, & 'Shap_alwaysExchTr =',' /* always exch(Tracer) nShapTr times*/') IF (Shap_funct.EQ.2) THEN CALL WRITE_0D_I( nShapTrPhys, INDEX_NONE, & 'nShapTrPhys =', & ' /* power of physical-space filter (Tracer) */') CALL WRITE_0D_I( nShapUVPhys, INDEX_NONE, & 'nShapUVPhys =', & ' /* power of physical-space filter (Momentum) */') ENDIF CALL WRITE_0D_RL( Shap_Trtau, INDEX_NONE, & 'Shap_Trtau =', & ' /* time scale of Shapiro filter (Tracer) */') CALL WRITE_0D_RL( Shap_TrLength, INDEX_NONE, & 'Shap_TrLength =', & ' /* Length scale of Shapiro filter (Tracer) */') CALL WRITE_0D_RL( Shap_uvtau, INDEX_NONE, & 'Shap_uvtau =', & ' /* time scale of Shapiro filter (Momentum) */') CALL WRITE_0D_RL( Shap_uvLength, INDEX_NONE, & 'Shap_uvLength =', & ' /* Length scale of Shapiro filter (Momentum) */') CALL WRITE_0D_RL( Shap_noSlip, INDEX_NONE, & 'Shap_noSlip =', & ' /* No-slip parameter (0=Free-slip ; 1=No-slip)*/') CALL WRITE_0D_RL( Shap_diagFreq, INDEX_NONE, & 'Shap_diagFreq =', & ' /* Frequency^-1 for diagnostic output (s)*/') C-- Check the Options : #ifndef USE_OLD_SHAPIRO_FILTERS #ifdef NO_SLIP_SHAP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| WRITE(msgBuf,'(2A)') 'SHAP_FILT: CPP-option NO_SLIP_SHAP', & ' only in OLD_SHAPIRO S/R ;' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(2A)') ' ==> use parameter Shap_noSlip=1. ', & '(in "data.shap") instead' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS' #endif #endif C-- Check the parameters : IF ( .NOT.shap_filt_uvStar ) THEN C- Notes: applying the filter at the end of the time step (after SOLVE_FOR_P) C affects the barotropic flow divergence ; this might not be consistent C with some option of the code. IF ( rigidLid ) THEN WRITE(msgBuf,'(2A)') 'SHAP_FILT with rigidLid ', & 'needs shap_filt_uvStar=.true.' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS' ELSEIF ( .NOT.exactConserv ) THEN WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ', & 'applying Filter after SOLVE_FOR_P (shap_filt_uvStar=FALSE)' CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1) WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ', & 'requires to recompute Eta after ==> turn on exactConserv ' CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1) ENDIF ENDIF C- Some Filters / options are not available on CS-grid: IF (useCubedSphereExchange) THEN IF ( Shap_funct.EQ.1 .OR. Shap_funct.EQ.4 ) THEN WRITE(msgBuf,'(2A,I3)') 'SHAP_FILT on CS-grid ', & 'does not work with Shap_funct=', Shap_funct CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS' ELSEIF ( Shap_funct.EQ.21 .AND. nShapUV.GT.0 & .AND. nSx*nSy*nPx*nPy .NE. 6 ) THEN WRITE(msgBuf,'(2A)') 'SHAP_FILT on CS-grid:', & ' multi-tiles / face not implemented with' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(A,I3,A)') ' Shap_funct=', Shap_funct, & ' ; => use instead Shap_funct=2 & nShap[]Phys=0' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS' ENDIF ENDIF _END_MASTER(myThid) C-- Everyone else must wait for the parameters to be loaded _BARRIER #endif /* ALLOW_SHAP_FILT */ RETURN END