/[MITgcm]/MITgcm/pkg/gmredi/gmredi_check.F
ViewVC logotype

Annotation of /MITgcm/pkg/gmredi/gmredi_check.F

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


Revision 1.32 - (hide annotations) (download)
Thu Sep 24 21:31:35 2015 UTC (8 years, 8 months ago) by dfer
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.31: +7 -7 lines
Small fixes

1 dfer 1.32 C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_check.F,v 1.31 2015/02/22 01:52:18 m_bates Exp $
2 jmc 1.8 C $Name: $
3 heimbach 1.1
4 edhill 1.9 #include "GMREDI_OPTIONS.h"
5 jmc 1.14 #ifdef ALLOW_PTRACERS
6     # include "PTRACERS_OPTIONS.h"
7     #endif
8 heimbach 1.1
9 jmc 1.13 CBOP
10     C !ROUTINE: GMREDI_CHECK
11     C !INTERFACE:
12 heimbach 1.1 SUBROUTINE GMREDI_CHECK( myThid )
13 jmc 1.13
14     C !DESCRIPTION: \bv
15     C *==========================================================*
16     C | SUBROUTINE GMREDI_CHECK
17     C | o Check consistency with model configuration
18     C *==========================================================*
19     C *==========================================================*
20     C \ev
21    
22     C !USES:
23 heimbach 1.1 IMPLICIT NONE
24    
25     C === Global variables ===
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29     #include "GMREDI.h"
30 jmc 1.12 #ifdef ALLOW_GENERIC_ADVDIFF
31 jmc 1.14 # include "GAD.h"
32     #endif
33     #ifdef ALLOW_PTRACERS
34     # include "PTRACERS_SIZE.h"
35 jmc 1.15 # include "PTRACERS_PARAMS.h"
36 jmc 1.12 #endif
37 heimbach 1.1
38 jmc 1.13 C !INPUT/OUTPUT PARAMETERS:
39 heimbach 1.1 C === Routine arguments ===
40 jmc 1.13 C myThid :: my Thread Id number
41 heimbach 1.1 INTEGER myThid
42    
43 jmc 1.13 #ifdef ALLOW_GMREDI
44     C !LOCAL VARIABLES:
45 heimbach 1.1 C === Local variables ===
46 jmc 1.20 C msgBuf :: Informational/error message buffer
47 heimbach 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
48 jmc 1.13 CEOP
49 jmc 1.14 #ifdef ALLOW_PTRACERS
50     INTEGER iTr
51     LOGICAL redFlag
52     #endif
53 heimbach 1.1
54 jmc 1.13 _BEGIN_MASTER(myThid)
55 heimbach 1.1
56 adcroft 1.3 WRITE(msgBuf,'(A)') 'GMREDI_CHECK: #define GMREDI'
57     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
58 jmc 1.13 & SQUEEZE_RIGHT , myThid )
59 heimbach 1.1
60 jmc 1.5 C- print out some kee parameters :
61     CALL WRITE_0D_L( GM_AdvForm, INDEX_NONE,
62 jmc 1.17 & 'GM_AdvForm =', ' /* if FALSE => use SkewFlux Form */')
63 gforget 1.16 CALL WRITE_0D_L( GM_InMomAsStress, INDEX_NONE,
64 jmc 1.17 & 'GM_InMomAsStress =', ' /* if TRUE => apply as Eddy Stress */')
65 jmc 1.6 CALL WRITE_0D_L( GM_AdvSeparate, INDEX_NONE,
66 jmc 1.13 & 'GM_AdvSeparate =',' /* Calc Bolus & Euler Adv. separately */')
67 jmc 1.5 CALL WRITE_0D_L( GM_ExtraDiag, INDEX_NONE,
68 jmc 1.17 & 'GM_ExtraDiag =',' /* Tensor Extra Diag (line 1&2) non 0 */')
69 jmc 1.18 CALL WRITE_0D_RL( GM_isopycK, INDEX_NONE, 'GM_isopycK =',
70 jmc 1.17 & ' /* Background Isopyc. Diffusivity [m^2/s] */')
71 jmc 1.18 CALL WRITE_0D_RL( GM_background_K*GM_skewflx, INDEX_NONE,
72 jmc 1.17 & 'GM_skewflx*K =',
73     & ' /* Background GM_SkewFlx Diffusivity [m^2/s] */')
74 jmc 1.18 CALL WRITE_0D_RL( GM_background_K*GM_advect, INDEX_NONE,
75 jmc 1.17 & 'GM_advec*K =',
76     & ' /* Backg. GM-Advec(=Bolus) Diffusivity [m^2/s]*/')
77 jmc 1.19 CALL WRITE_0D_RL( GM_Kmin_horiz, INDEX_NONE, 'GM_Kmin_horiz =',
78 jmc 1.17 & ' /* Minimum Horizontal Diffusivity [m^2/s] */')
79 jmc 1.18 CALL WRITE_0D_RL( GM_Visbeck_alpha, INDEX_NONE,
80 jmc 1.17 & 'GM_Visbeck_alpha =', ' /* Visbeck alpha coeff. [-] */')
81 jmc 1.18 CALL WRITE_0D_RL( GM_Small_Number, INDEX_NONE,
82 jmc 1.17 & 'GM_Small_Number =', ' /* epsilon used in slope calc */')
83 jmc 1.18 CALL WRITE_0D_RL( GM_slopeSqCutoff, INDEX_NONE,
84 jmc 1.17 & 'GM_slopeSqCutoff =', ' /* Slope^2 cut-off value */')
85     CALL WRITE_0D_C( GM_taper_scheme, 0, INDEX_NONE,
86     & 'GM_taper_scheme =',
87     & ' /* Type of Tapering/Clipping scheme */')
88 jmc 1.18 CALL WRITE_0D_RL( GM_maxSlope, INDEX_NONE,
89 jmc 1.17 & 'GM_maxSlope =', ' /* Maximum Slope (Tapering/Clipping) */')
90 jmc 1.18 CALL WRITE_0D_RL( GM_facTrL2dz, INDEX_NONE,
91 jmc 1.17 & 'GM_facTrL2dz =',
92     & ' /* Minimum Trans.Layer Thick. (factor of dz) */')
93 jmc 1.18 CALL WRITE_0D_RL( GM_facTrL2ML, INDEX_NONE,
94 jmc 1.17 & 'GM_facTrL2ML =',
95     & ' /* Max.Trans.Layer Thick. (factor of MxL Depth)*/')
96 jmc 1.18 CALL WRITE_0D_RL( GM_maxTransLay, INDEX_NONE,
97 jmc 1.17 & 'GM_maxTransLay =',
98     & ' /* Maximum Transition Layer Thickness [m] */')
99 jmc 1.24 CALL WRITE_0D_L( GM_UseBVP, INDEX_NONE,
100     & 'GM_UseBVP =',
101     & ' /* if TRUE => use bvp a la Ferrari et al. (2010) */')
102     CALL WRITE_0D_I( GM_BVP_ModeNumber, INDEX_NONE,
103     & 'GM_BVP_ModeNumber =',
104     & ' /* Vertical mode number for BVP wave speed */')
105     CALL WRITE_0D_RL( GM_BVP_cMin, INDEX_NONE,
106     & 'GM_BVP_cMin =',
107     & ' /* Minimum wave speed for BVP [m/s] */')
108 jmc 1.25 CALL WRITE_0D_L( GM_useSubMeso, INDEX_NONE,
109     & 'GM_useSubMeso =',
110     & ' /* if TRUE => use Sub-Meso param. (B.Fox-Kemper) */')
111     CALL WRITE_0D_RL( subMeso_Ceff, INDEX_NONE,
112     & 'subMeso_Ceff =',
113     & ' /* efficiency coeff. of Mixed-Layer Eddies [-] */')
114     CALL WRITE_0D_RL( subMeso_invTau, INDEX_NONE,
115     & 'subMeso_invTau =',
116     & ' /* inverse of Sub-Meso mixing time-scale [/s] */')
117     CALL WRITE_0D_RL( subMeso_LfMin, INDEX_NONE,
118     & 'subMeso_LfMin =',' /* minimum length-scale "Lf" [m] */')
119     CALL WRITE_0D_RS( subMeso_Lmax, INDEX_NONE,
120     & 'subMeso_Lmax =',' /* maximum grid-scale length [m] */')
121 jmc 1.10
122     C-- Check parameters:
123    
124     C- GM/Redi needs implicit diffusion (will be packaged later)
125 jmc 1.13 IF ( .NOT.implicitDiffusion ) THEN
126 jmc 1.10 WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'
127 jmc 1.13 CALL PRINT_ERROR( msgBuf , myThid )
128 jmc 1.10 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
129 jmc 1.13 ENDIF
130 jmc 1.10
131     #ifndef GM_VISBECK_VARIABLE_K
132     C Make sure we are not trying to use something that is unavailable
133 jmc 1.13 IF ( GM_Visbeck_alpha.NE.0. ) THEN
134 jmc 1.10 WRITE(msgBuf,'(A)')
135     & ' GMREDI_CHECK: Visbeck variables used in data.gmredi'
136 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
137 jmc 1.10 WRITE(msgBuf,'(A)')
138     & ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K'
139 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
140 jmc 1.10 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
141     ENDIF
142     #endif
143    
144     #ifndef GM_BOLUS_ADVEC
145     C Make sure we are not trying to use some arrays that are unavailable
146 jmc 1.13 IF ( GM_AdvForm ) THEN
147 jmc 1.10 WRITE(msgBuf,'(A)')
148     & ' GMREDI_CHECK: GM Advection form used in data.gmredi'
149 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
150 jmc 1.10 WRITE(msgBuf,'(A)')
151     & ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC'
152 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
153 jmc 1.10 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
154 heimbach 1.1 ENDIF
155 jmc 1.10 #endif
156 heimbach 1.1
157 m_bates 1.26 #ifdef GM_K3D
158 m_bates 1.30 # ifndef HAVE_LAPACK
159 m_bates 1.28 WRITE(msgBuf, '(A)')
160 m_bates 1.30 & 'Must use CPP option HAVE_LAPACK when using GM_K3D'
161 m_bates 1.28 CALL PRINT_ERROR( msgBuf, myThid )
162     STOP ' ABNORMAL END: S/R GMREDI_CHECK'
163     # endif
164    
165     IF ( GM_useK3D) THEN
166     CALL WRITE_0D_L( GM_useK3D, INDEX_NONE,
167     & 'GM_useK3D =', ' /* if TRUE => use K3D for diffusivity */')
168 dfer 1.32
169 m_bates 1.31 IF ( GM_K3D_use_constK ) THEN
170     CALL WRITE_0D_L( GM_K3D_use_constK, INDEX_NONE,
171 dfer 1.32 & 'GM_K3D_use_constK =',
172 m_bates 1.31 & ' /* if TRUE => Uses a constant K for'//
173 dfer 1.32 & ' the eddy transport closure */')
174    
175 m_bates 1.28 CALL WRITE_0D_L( GM_K3D_smooth, INDEX_NONE,
176 dfer 1.32 & 'GM_K3D_smooth =',
177 m_bates 1.28 & ' /* if TRUE => Expands in terms of baroclinic modes */')
178 dfer 1.32
179 m_bates 1.28 IF ( GM_K3D_smooth ) THEN
180     CALL WRITE_0D_I( GM_K3D_NModes, INDEX_NONE,
181     & 'GM_K3D_NModes =',
182     & ' /* Number of modes for expansion */')
183     ENDIF
184    
185     ELSE
186     CALL WRITE_0D_I( GM_K3D_NModes, INDEX_NONE,
187     & 'GM_K3D_NModes =',
188     & ' /* Number of modes for expansion */')
189    
190     ENDIF
191    
192     ENDIF
193    
194 m_bates 1.26 C Make sure that we use K3D with the advective form only.
195     C The skew form is not presently supported.
196     IF ( GM_useK3D .AND. .NOT. GM_AdvForm) THEN
197     WRITE(msgBuf,'(A)')
198     & ' GMREDI_CHECK: GM_useK3D=.TRUE. but GM_AdvForm=.FALSE.'
199     CALL PRINT_ERROR( msgBuf, myThid )
200     WRITE(msgBuf,'(A)')
201     & ' GMREDI_CHECK: To use GM_useK3D set GM_AdvForm=.TRUE.'
202     CALL PRINT_ERROR( msgBuf, myThid )
203 m_bates 1.27 STOP ' ABNORMAL END: S/R GMREDI_CHECK'
204     ENDIF
205    
206 m_bates 1.26 #endif
207    
208 jmc 1.10 #ifndef GM_EXTRA_DIAGONAL
209     C Make sure we are not trying to use some arrays that are unavailable
210 jmc 1.13 IF ( GM_ExtraDiag ) THEN
211 jmc 1.10 WRITE(msgBuf,'(A)')
212     & ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal'
213 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
214 jmc 1.10 WRITE(msgBuf,'(A)')
215     & ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL'
216 jmc 1.13 CALL PRINT_ERROR( msgBuf, myThid )
217 jmc 1.10 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
218     ENDIF
219 heimbach 1.1 #endif
220 jmc 1.10
221 jmc 1.21 #ifndef GM_NON_UNITY_DIAGONAL
222     IF ( GM_iso2dFile .NE. ' ' .OR.
223     & GM_iso1dFile .NE. ' ' ) THEN
224     WRITE(msgBuf,'(A)')
225     & ' GMREDI_CHECK: needs #define GM_NON_UNITY_DIAGONAL'
226     CALL PRINT_ERROR( msgBuf, myThid )
227     WRITE(msgBuf,'(A)')
228     & ' GMREDI_CHECK: to use GM_iso2dFile or GM_iso1dFile'
229     CALL PRINT_ERROR( msgBuf, myThid )
230     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
231     ENDIF
232     #endif
233    
234 jmc 1.25 #ifdef GM_EXCLUDE_SUBMESO
235     IF ( GM_useSubMeso ) THEN
236     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK: ',
237     & 'cannot use Sub-Meso (GM_useSubMeso=T)'
238     CALL PRINT_ERROR( msgBuf, myThid )
239     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK: ',
240     & 'when compiled with #define GM_EXCLUDE_SUBMESO'
241     CALL PRINT_ERROR( msgBuf, myThid )
242     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
243     ENDIF
244     #endif /* GM_EXCLUDE_SUBMESO */
245    
246     IF ( GM_useSubMeso .AND. .NOT.GM_AdvForm ) THEN
247     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK: ',
248     & 'Sub-Meso only implemented within GM_AdvForm'
249     CALL PRINT_ERROR( msgBuf, myThid )
250     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
251     ENDIF
252    
253 jmc 1.23 IF ( GM_InMomAsStress ) THEN
254 jmc 1.22 #ifdef ALLOW_EDDYPSI
255 m_bates 1.29 IF (.NOT. GM_AdvForm) THEN
256     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK: ',
257     & 'GM_InMomAsStress=.TRUE. but GM_AdvForm=.FALSE.'
258     CALL PRINT_ERROR( msgBuf, myThid )
259     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
260     ENDIF
261     IF (.NOT. GM_useK3D) THEN
262     WRITE(msgBuf,'(3A)')
263     & ' GMREDI_CHECK: Using GM_InMomAsStress and not',
264     & ' GM_useK3D. GM_InMomAsStress=.true. has only been',
265     & ' tested with GM_K3D=.true.'
266     ENDIF
267 jmc 1.23 #else /* ALLOW_EDDYPSI */
268     WRITE(msgBuf,'(2A)')
269     & ' GMREDI_CHECK: need to define ALLOW_EDDYPSI in CPP_OPTIONS.h',
270     & ' to use GM_InMomAsStress'
271     CALL PRINT_ERROR( msgBuf, myThid )
272     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
273     #endif /* ALLOW_EDDYPSI */
274     ENDIF
275     IF ( GM_InMomAsStress .AND. .NOT.GM_AdvForm ) THEN
276     WRITE(msgBuf,'(A)')
277     & ' GMREDI_CHECK: need GM_AdvForm=T to use GM_InMomAsStress'
278     CALL PRINT_ERROR( msgBuf, myThid )
279     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
280     ENDIF
281 jmc 1.22
282 jmc 1.14 #ifdef ALLOW_PTRACERS
283     IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
284     & .AND. usePTRACERS ) THEN
285     redFlag = .FALSE.
286     DO iTr=1,PTRACERS_numInUse
287     IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN
288     redFlag = .TRUE.
289     WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:',
290     & ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr)
291     CALL PRINT_ERROR( msgBuf, myThid )
292     ENDIF
293     ENDDO
294     IF ( redFlag ) THEN
295     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:',
296     & ' but GM Advective Form applies to all tracers !'
297     CALL PRINT_ERROR( msgBuf, myThid )
298     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
299     ENDIF
300     ENDIF
301     #endif /* ALLOW_PTRACERS */
302    
303 jmc 1.12 #ifdef ALLOW_GENERIC_ADVDIFF
304 jmc 1.11 C Check size of overlap region
305 jmc 1.10 IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
306 jmc 1.11 & .AND. GM_Visbeck_alpha.NE.0.
307 jmc 1.20 & .AND. useMultiDimAdvec ) THEN
308 jmc 1.11 C Visbeck variable K requires 1 more row/column in the overlap:
309     C might need to increase Olx,Oly from 2 to 3 if GM advective
310     C form & multi-dim advection are used. This happens when:
311     C a) using a 5 points stencil advection scheme ; or
312     C b) using a 3 points stencil advection scheme on CS-grid
313 jmc 1.20 GAD_OlMinSize(2) = MAX( GAD_OlMinSize(2), 1)
314     WRITE(msgBuf,'(A,9I3)')
315     & 'GMREDI_CHECK: GAD_OlMinSize=', GAD_OlMinSize
316     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
317     & SQUEEZE_RIGHT , myThid )
318 jmc 1.10 ENDIF
319 jmc 1.12 #endif /* ALLOW_GENERIC_ADVDIFF */
320 jmc 1.10
321     _END_MASTER(myThid)
322    
323     #endif /* ALLOW_GMREDI */
324 adcroft 1.3 RETURN
325     END

  ViewVC Help
Powered by ViewVC 1.1.22