pkg/shap_filt/shap_filt_readparms.F

C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_readparms.F,v 1.7 2002/07/31 21:01:25 jmc Exp $
C $Name:  $

#include "SHAP_FILT_OPTIONS.h"

      SUBROUTINE SHAP_FILT_READPARMS( myThid )
C     /==========================================================\
C     | SUBROUTINE SHAP_FILT_READPARMS                           |
C     | o Routine to initialize Shapiro Filter parameters        |
C     |==========================================================|
C     \==========================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "SHAP_FILT.h"

C     === Routine arguments ===
      INTEGER myThid

#ifdef ALLOW_SHAP_FILT

      NAMELIST /SHAP_PARM01/
     & Shap_funct, shap_filt_uvStar, shap_filt_TrStagg,
     &    nShapT,  nShapTrPhys, Shap_Trtau, Shap_TrLength,
     &    nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength,
     &    Shap_noSlip, Shap_diagFreq

C     === Local variables ===
C     msgBuf      - Informational/error meesage buffer
C     iUnit       - Work variable for IO unit number
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER iUnit

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.
      nShapT = 0
      nShapUV = 0
      nShapTrPhys = 0
      nShapUVPhys = 0
      Shap_Trtau = deltaTtracer
      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
      CLOSE(iUnit)

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,
     & 'nShapTr =',
     & '   /* power of Shapiro filter for Tracers */')  
      CALL WRITE_0D_I( nShapUV, INDEX_NONE,
     & 'nShapUV =',
     & '   /* power of Shapiro filter for momentum */')  

      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_R8( Shap_Trtau, INDEX_NONE,
     & 'Shap_Trtau =',
     & '   /* time scale of Shapiro filter (Tracer) */')  
      CALL WRITE_0D_R8( Shap_TrLength, INDEX_NONE,
     & 'Shap_TrLength =',
     & '   /* Length scale of Shapiro filter (Tracer) */')  
      CALL WRITE_0D_R8( Shap_uvtau, INDEX_NONE,
     & 'Shap_uvtau =',
     & '   /* time scale of Shapiro filter (Momentum) */')  
      CALL WRITE_0D_R8( Shap_uvLength, INDEX_NONE,
     & 'Shap_uvLength =',
     & '   /* Length scale of Shapiro filter (Momentum) */')  
      CALL WRITE_0D_R8( Shap_noSlip, INDEX_NONE,
     & 'Shap_noSlip =',
     &  '  /* No-slip parameter (0=Free-slip ; 1=No-slip)*/')  
      CALL WRITE_0D_R8( Shap_diagFreq, INDEX_NONE,
     & 'Shap_diagFreq =',
     & '   /* Frequency^-1 for diagnostic output (s)*/')  

      _END_MASTER(myThid)

C--   Everyone else must wait for the parameters to be loaded
      _BARRIER

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                    

#endif /* ALLOW_SHAP_FILT */
      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_readparms.F,v 1.7 2002/07/31 21:01:25 jmc Exp $
2	jmc	1.3	C $Name: $
3	adcroft	1.2
4			#include "SHAP_FILT_OPTIONS.h"
5
6			SUBROUTINE SHAP_FILT_READPARMS( myThid )
7			C /==========================================================\
8			C \| SUBROUTINE SHAP_FILT_READPARMS \|
9			C \| o Routine to initialize Shapiro Filter parameters \|
10			C \|==========================================================\|
11			C \==========================================================/
12			IMPLICIT NONE
13
14			C === Global variables ===
15			#include "SIZE.h"
16			#include "EEPARAMS.h"
17			#include "PARAMS.h"
18			#include "SHAP_FILT.h"
19
20			C === Routine arguments ===
21			INTEGER myThid
22
23			#ifdef ALLOW_SHAP_FILT
24
25	jmc	1.5	NAMELIST /SHAP_PARM01/
26			& Shap_funct, shap_filt_uvStar, shap_filt_TrStagg,
27			& nShapT, nShapTrPhys, Shap_Trtau, Shap_TrLength,
28	jmc	1.6	& nShapUV, nShapUVPhys, Shap_uvtau, Shap_uvLength,
29	jmc	1.8	& Shap_noSlip, Shap_diagFreq
30	adcroft	1.2
31			C === Local variables ===
32			C msgBuf - Informational/error meesage buffer
33			C iUnit - Work variable for IO unit number
34			CHARACTER*(MAX_LEN_MBUF) msgBuf
35			INTEGER iUnit
36
37			C-- SHAP_FILT_READPARMS has been called so we know that
38			C the package is active.
39			c SHAPIsOn=.TRUE.
40
41			_BEGIN_MASTER(myThid)
42
43			WRITE(msgBuf,'(A)') ' SHAP_FILT_READPARMS: opening data.shap'
44			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
45			& SQUEEZE_RIGHT , 1)
46
47			CALL OPEN_COPY_DATA_FILE(
48			I 'data.shap', 'SHAP_FILT_READPARMS',
49			O iUnit,
50			I myThid )
51
52			C-- Default flags and values for Shapiro Filter
53	jmc	1.3	Shap_funct = 2
54	jmc	1.5	shap_filt_uvStar =.TRUE.
55			shap_filt_TrStagg=.TRUE.
56	adcroft	1.2	nShapT = 0
57			nShapUV = 0
58	jmc	1.3	nShapTrPhys = 0
59			nShapUVPhys = 0
60	adcroft	1.2	Shap_Trtau = deltaTtracer
61			Shap_TrLength = 0.
62			Shap_uvtau = deltaTMom
63			Shap_TrLength = 0.
64	jmc	1.6	Shap_noSlip = 0.
65	jmc	1.8	Shap_diagFreq = diagFreq
66	adcroft	1.2
67			C-- Read parameters from open data file
68			READ(UNIT=iUnit,NML=SHAP_PARM01)
69
70			WRITE(msgBuf,'(A)')
71			& ' SHAP_FILT_READPARMS: finished reading data.shap'
72			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
73			& SQUEEZE_RIGHT , 1)
74
75			C-- Close the open data file
76			CLOSE(iUnit)
77	jmc	1.6
78			C- print out some kee parameters :
79			CALL WRITE_0D_I( Shap_funct, INDEX_NONE,
80			& 'Shap_funct =',
81			& ' /* select Shapiro filter function */')
82			CALL WRITE_0D_I( nShapT , INDEX_NONE,
83			& 'nShapTr =',
84			& ' /* power of Shapiro filter for Tracers */')
85			CALL WRITE_0D_I( nShapUV, INDEX_NONE,
86			& 'nShapUV =',
87			& ' /* power of Shapiro filter for momentum */')
88
89			IF (Shap_funct.EQ.2) THEN
90			CALL WRITE_0D_I( nShapTrPhys, INDEX_NONE,
91			& 'nShapTrPhys =',
92			& ' /* power of physical-space filter (Tracer) */')
93			CALL WRITE_0D_I( nShapUVPhys, INDEX_NONE,
94			& 'nShapUVPhys =',
95			& ' /* power of physical-space filter (Momentum) */')
96			ENDIF
97
98			CALL WRITE_0D_R8( Shap_Trtau, INDEX_NONE,
99			& 'Shap_Trtau =',
100			& ' /* time scale of Shapiro filter (Tracer) */')
101			CALL WRITE_0D_R8( Shap_TrLength, INDEX_NONE,
102			& 'Shap_TrLength =',
103			& ' /* Length scale of Shapiro filter (Tracer) */')
104			CALL WRITE_0D_R8( Shap_uvtau, INDEX_NONE,
105			& 'Shap_uvtau =',
106			& ' /* time scale of Shapiro filter (Momentum) */')
107			CALL WRITE_0D_R8( Shap_uvLength, INDEX_NONE,
108			& 'Shap_uvLength =',
109			& ' /* Length scale of Shapiro filter (Momentum) */')
110			CALL WRITE_0D_R8( Shap_noSlip, INDEX_NONE,
111			& 'Shap_noSlip =',
112	jmc	1.8	& ' /* No-slip parameter (0=Free-slip ; 1=No-slip)*/')
113			CALL WRITE_0D_R8( Shap_diagFreq, INDEX_NONE,
114			& 'Shap_diagFreq =',
115			& ' /* Frequency^-1 for diagnostic output (s)*/')
116	jmc	1.6
117	adcroft	1.2	_END_MASTER(myThid)
118
119			C-- Everyone else must wait for the parameters to be loaded
120			_BARRIER
121	jmc	1.6
122			C-- Check the Options :
123			#ifndef USE_OLD_SHAPIRO_FILTERS
124			#ifdef NO_SLIP_SHAP
125			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
126			WRITE(msgBuf,'(2A)') 'SHAP_FILT: CPP-option NO_SLIP_SHAP',
127			& ' only in OLD_SHAPIRO S/R ;'
128			CALL PRINT_ERROR( msgBuf , 1)
129			WRITE(msgBuf,'(2A)') ' ==> use parameter Shap_noSlip=1. ',
130			& '(in "data.shap") instead'
131			CALL PRINT_ERROR( msgBuf , 1)
132			STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
133			#endif
134			#endif
135	jmc	1.5
136			C-- Check the parameters :
137
138			IF ( .NOT.shap_filt_uvStar ) THEN
139
140			C- Notes: applying the filter at the end of the time step (after SOLVE_FOR_P)
141			C affects the barotropic flow divergence ; this might not be consistent
142			C with some option of the code.
143
144			IF ( rigidLid ) THEN
145			WRITE(msgBuf,'(2A)') 'SHAP_FILT with rigidLid ',
146			& 'needs shap_filt_uvStar=.true.'
147			CALL PRINT_ERROR( msgBuf , 1)
148			STOP 'ABNORMAL END: S/R SHAP_FILT_READPARMS'
149			ELSEIF ( .NOT.exactConserv ) THEN
150			WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ',
151			& 'applying Filter after SOLVE_FOR_P (shap_filt_uvStar=FALSE)'
152	jmc	1.7	CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)
153	jmc	1.5	WRITE(msgBuf,'(2A)') 'S/R SHAP_FILT_READPARMS: WARNING <<< ',
154			& 'requires to recompute Eta after ==> turn on exactConserv '
155	jmc	1.7	CALL PRINT_MESSAGE(msgBuf, errorMessageUnit, SQUEEZE_RIGHT,1)
156	jmc	1.5	ENDIF
157
158			ENDIF
159	adcroft	1.2
160			#endif /* ALLOW_SHAP_FILT */
161			RETURN
162			END