/[MITgcm]/MITgcm_contrib/submesoscale/code/gmredi_check.F
ViewVC logotype

Contents of /MITgcm_contrib/submesoscale/code/gmredi_check.F

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


Revision 1.2 - (show annotations) (download)
Fri May 30 22:13:42 2008 UTC (17 years, 1 month ago) by dimitri
Branch: MAIN
Changes since 1.1: +16 -0 lines
Initial code submitted by Baylor on May 19, 2008.  See:
http://forge.csail.mit.edu/pipermail/mitgcm-devel/2008-May/003392.html

1 C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_check.F,v 1.15 2007/11/05 19:03:26 jmc Exp $
2 C $Name: $
3
4 #include "GMREDI_OPTIONS.h"
5 #ifdef ALLOW_PTRACERS
6 # include "PTRACERS_OPTIONS.h"
7 #endif
8
9 CBOP
10 C !ROUTINE: GMREDI_CHECK
11 C !INTERFACE:
12 SUBROUTINE GMREDI_CHECK( myThid )
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 IMPLICIT NONE
24
25 C === Global variables ===
26 #include "SIZE.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29 #include "GMREDI.h"
30 #ifdef ALLOW_GENERIC_ADVDIFF
31 # include "GAD.h"
32 #endif
33 #ifdef ALLOW_PTRACERS
34 # include "PTRACERS_SIZE.h"
35 # include "PTRACERS_PARAMS.h"
36 #endif
37
38 C !INPUT/OUTPUT PARAMETERS:
39 C === Routine arguments ===
40 C myThid :: my Thread Id number
41 INTEGER myThid
42
43 #ifdef ALLOW_GMREDI
44 C !LOCAL VARIABLES:
45 C === Local variables ===
46 C msgBuf :: Informational/error meesage buffer
47 CHARACTER*(MAX_LEN_MBUF) msgBuf
48 CEOP
49 #ifdef ALLOW_PTRACERS
50 INTEGER iTr
51 LOGICAL redFlag
52 #endif
53
54 _BEGIN_MASTER(myThid)
55
56 WRITE(msgBuf,'(A)') 'GMREDI_CHECK: #define GMREDI'
57 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
58 & SQUEEZE_RIGHT , myThid )
59
60 C- print out some kee parameters :
61 CALL WRITE_0D_L( GM_AdvForm, INDEX_NONE,
62 & 'GM_AdvForm =', ' /* if FALSE => use SkewFlux Form */')
63 CALL WRITE_0D_L( GM_AdvSeparate, INDEX_NONE,
64 & 'GM_AdvSeparate =',' /* Calc Bolus & Euler Adv. separately */')
65 CALL WRITE_0D_L( GM_ExtraDiag, INDEX_NONE,
66 & 'GM_ExtraDiag =',' /* Tensor Extra Diag (line 1&2) non 0 */')
67 CALL WRITE_0D_R8( GM_isopycK, INDEX_NONE, 'GM_isopycK =',
68 & ' /* Background Isopyc. Diffusivity ( m^2/s ) */')
69 CALL WRITE_0D_R8( GM_background_K*GM_skewflx, INDEX_NONE,
70 & ' GM_skewflx*K =',
71 & ' /* Background GM_SkewFlx Diffusivity ( m^2/s ) */')
72 CALL WRITE_0D_R8( GM_background_K*GM_advect, INDEX_NONE,
73 & ' GM_advec*K =',
74 & ' /* Backg. GM-Advec(=Bolus) Diffusivity ( m^2/s ) */')
75 CALL WRITE_0D_R8( GM_Visbeck_alpha, INDEX_NONE,
76 & ' GM_Visbeck_alpha =',' /* Visbeck alpha coeff. ( ) */')
77 WRITE(msgBuf,'(A,A40)')' Tapering/Cliping : ',GM_taper_scheme
78 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
79 & SQUEEZE_RIGHT, myThid )
80 CALL WRITE_0D_R8( GM_Small_Number, INDEX_NONE,
81 & ' GM_Small_Number =',' /* epsilon used in slope calc */')
82 CALL WRITE_0D_R8( GM_slopeSqCutoff, INDEX_NONE,
83 & ' GM_slopeSqCutoff =', ' /* Slope^2 cut-off value */')
84
85
86 C-- Check parameters:
87
88 C- GM/Redi needs implicit diffusion (will be packaged later)
89 IF ( .NOT.implicitDiffusion ) THEN
90 WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'
91 CALL PRINT_ERROR( msgBuf , myThid )
92 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
93 ENDIF
94
95 #ifndef GM_VISBECK_VARIABLE_K
96 C Make sure we are not trying to use something that is unavailable
97 IF ( GM_Visbeck_alpha.NE.0. ) THEN
98 WRITE(msgBuf,'(A)')
99 & ' GMREDI_CHECK: Visbeck variables used in data.gmredi'
100 CALL PRINT_ERROR( msgBuf, myThid )
101 WRITE(msgBuf,'(A)')
102 & ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K'
103 CALL PRINT_ERROR( msgBuf, myThid )
104 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
105 ENDIF
106 #endif
107
108 #ifndef GM_BOLUS_ADVEC
109 C Make sure we are not trying to use some arrays that are unavailable
110 IF ( GM_AdvForm ) THEN
111 WRITE(msgBuf,'(A)')
112 & ' GMREDI_CHECK: GM Advection form used in data.gmredi'
113 CALL PRINT_ERROR( msgBuf, myThid )
114 WRITE(msgBuf,'(A)')
115 & ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC'
116 CALL PRINT_ERROR( msgBuf, myThid )
117 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
118 ENDIF
119 #endif
120
121 #ifndef GM_EXTRA_DIAGONAL
122 C Make sure we are not trying to use some arrays that are unavailable
123 IF ( GM_ExtraDiag ) THEN
124 WRITE(msgBuf,'(A)')
125 & ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal'
126 CALL PRINT_ERROR( msgBuf, myThid )
127 WRITE(msgBuf,'(A)')
128 & ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL'
129 CALL PRINT_ERROR( msgBuf, myThid )
130 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
131 ENDIF
132 #endif
133
134 #ifdef GM_SUBMESO
135 IF (GM_SM_Ce .gt. 0 _d 0) THEN
136 C Make sure we are not trying to use some arrays that are unavailable
137 IF ((.not.GM_ExtraDiag ).and.(.not.GM_AdvForm)) THEN
138 WRITE(msgBuf,'(A)')
139 & ' GMREDI: GM_SUBMESO needs GM_EXTRA_DIAGONAL or GM_BOLUS_ADVEC'
140 CALL PRINT_ERROR( msgBuf, myThid )
141 WRITE(msgBuf,'(A)')
142 & ' GMREDI_CHECK: add #define GM_EXTRA_DIAGONAL'
143 CALL PRINT_ERROR( msgBuf, myThid )
144 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
145 ENDIF
146 ENDIF
147 #endif
148
149
150 #ifdef ALLOW_PTRACERS
151 IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
152 & .AND. usePTRACERS ) THEN
153 redFlag = .FALSE.
154 DO iTr=1,PTRACERS_numInUse
155 IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN
156 redFlag = .TRUE.
157 WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:',
158 & ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr)
159 CALL PRINT_ERROR( msgBuf, myThid )
160 ENDIF
161 ENDDO
162 IF ( redFlag ) THEN
163 WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:',
164 & ' but GM Advective Form applies to all tracers !'
165 CALL PRINT_ERROR( msgBuf, myThid )
166 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
167 ENDIF
168 ENDIF
169 #endif /* ALLOW_PTRACERS */
170
171 #ifdef ALLOW_GENERIC_ADVDIFF
172 C Check size of overlap region
173 IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
174 & .AND. GM_Visbeck_alpha.NE.0.
175 & .AND. useMultiDimAdvec
176 & .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN
177 C Visbeck variable K requires 1 more row/column in the overlap:
178 C might need to increase Olx,Oly from 2 to 3 if GM advective
179 C form & multi-dim advection are used. This happens when:
180 C a) using a 5 points stencil advection scheme ; or
181 C b) using a 3 points stencil advection scheme on CS-grid
182 C note: not clear how to check (b) since none of the advection scheme
183 C currently implemented falls in this category, except if
184 C GAD_FLUX_LIMITER.h is changed to use a "constant" flux-limiter
185 C (from Lax-Wendroff to 1rst Order upwind).
186 C-------
187 c IF ( (useCubedSphereExchange
188 c & .AND.( tempAdvScheme.EQ.ENUM_LAXWENDROFF
189 c & .OR. saltAdvScheme.EQ.ENUM_LAXWENDROFF )
190 c & ).OR.( tempAdvScheme.EQ.ENUM_FLUX_LIMIT
191 c & .OR. saltAdvScheme.EQ.ENUM_FLUX_LIMIT
192 c & .OR. tempAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
193 c & .OR. saltAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
194 c & .OR. tempAdvScheme.EQ.ENUM_DST3
195 c & .OR. saltAdvScheme.EQ.ENUM_DST3 )
196 c & ) THEN
197 WRITE(msgBuf,'(A,A)')
198 & 'GMREDI_CHECK: Visbeck + GM_AdvForm in MultiDimAdvec'
199 CALL PRINT_ERROR( msgBuf , myThid )
200 WRITE(msgBuf,'(A)') 'GMREDI_CHECK: need at least Olx,Oly = 3'
201 CALL PRINT_ERROR( msgBuf , myThid )
202 STOP 'ABNORMAL END: S/R GMREDI_CHECK'
203 c ENDIF
204 ENDIF
205 #endif /* ALLOW_GENERIC_ADVDIFF */
206
207 _END_MASTER(myThid)
208
209 #endif /* ALLOW_GMREDI */
210 RETURN
211 END

  ViewVC Help
Powered by ViewVC 1.1.22