/[MITgcm]/MITgcm/pkg/generic_advdiff/gad_init_fixed.F
ViewVC logotype

Contents of /MITgcm/pkg/generic_advdiff/gad_init_fixed.F

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


Revision 1.7 - (show annotations) (download)
Tue Nov 16 17:39:13 2010 UTC (13 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint65a, checkpoint62o, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.6: +97 -30 lines
-record overlap minimum size for each advection scheme
-add function GAD_VALID_ADVSCHEME to check for valid advection scheme
-check and stop (in gad_check) if overlap size is too small.

1 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_init_fixed.F,v 1.6 2009/04/28 23:27:24 jmc Exp $
2 C $Name: $
3
4 #include "GAD_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: GAD_INIT_FIXED
8 C !INTERFACE:
9 SUBROUTINE GAD_INIT_FIXED( myThid )
10 C !DESCRIPTION:
11 C Routine to initialize Generic Advection/Diffusion variables and
12 C constants.
13
14 C !USES:
15 IMPLICIT NONE
16 C === Global variables ===
17 #include "SIZE.h"
18 #include "EEPARAMS.h"
19 #include "PARAMS.h"
20 #include "GAD.h"
21
22 C !INPUT/OUTPUT PARAMETERS:
23 C === Routine arguments ===
24 C myThid :: My Thread Id. number
25 INTEGER myThid
26 CEOP
27
28 C !FUNCTIONS
29 LOGICAL GAD_VALID_ADVSCHEME
30 EXTERNAL GAD_VALID_ADVSCHEME
31
32 C !LOCAL VARIABLES:
33 C === Local variables ===
34 C msgBuf :: Informational/error message buffer
35 CHARACTER*(MAX_LEN_MBUF) msgBuf
36 LOGICAL validNum
37 INTEGER n
38
39 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
40
41 _BEGIN_MASTER(myThid)
42
43 C-- Initialise advection scheme parameter
44 DO n=1,GAD_Scheme_MaxNum
45 GAD_Scheme_olSize(n) = 0
46 ENDDO
47 validNum = GAD_VALID_ADVSCHEME( ENUM_UPWIND_1RST )
48 & .AND. GAD_VALID_ADVSCHEME( ENUM_CENTERED_2ND )
49 & .AND. GAD_VALID_ADVSCHEME( ENUM_UPWIND_3RD )
50 & .AND. GAD_VALID_ADVSCHEME( ENUM_CENTERED_4TH )
51 & .AND. GAD_VALID_ADVSCHEME( ENUM_DST2 )
52 & .AND. GAD_VALID_ADVSCHEME( ENUM_FLUX_LIMIT )
53 & .AND. GAD_VALID_ADVSCHEME( ENUM_DST3 )
54 & .AND. GAD_VALID_ADVSCHEME( ENUM_DST3_FLUX_LIMIT )
55 & .AND. GAD_VALID_ADVSCHEME( ENUM_OS7MP )
56 & .AND. GAD_VALID_ADVSCHEME( ENUM_SOM_PRATHER )
57 & .AND. GAD_VALID_ADVSCHEME( ENUM_SOM_LIMITER )
58 IF ( .NOT.validNum ) THEN
59 WRITE(msgBuf,'(A)')
60 & 'GAD_INIT_FIXED: Coding error in Advection-Scheme Number'
61 CALL PRINT_ERROR( msgBuf, myThid )
62 WRITE(msgBuf,'(2A,I4)') 'GAD_INIT_FIXED:',
63 & ' one exceeds GAD_Scheme_MaxNum=', GAD_Scheme_MaxNum
64 CALL PRINT_ERROR( msgBuf, myThid )
65 STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
66 ENDIF
67 C- Set overlap minimum size for each advection scheme:
68 GAD_Scheme_olSize( ENUM_UPWIND_1RST ) = 1
69 GAD_Scheme_olSize( ENUM_CENTERED_2ND ) = 1
70 GAD_Scheme_olSize( ENUM_UPWIND_3RD ) = 2
71 GAD_Scheme_olSize( ENUM_CENTERED_4TH ) = 2
72 GAD_Scheme_olSize( ENUM_DST2 ) = 1
73 GAD_Scheme_olSize( ENUM_FLUX_LIMIT ) = 2
74 GAD_Scheme_olSize( ENUM_DST3 ) = 2
75 GAD_Scheme_olSize( ENUM_DST3_FLUX_LIMIT ) = 2
76 GAD_Scheme_olSize( ENUM_OS7MP ) = 4
77 GAD_Scheme_olSize( ENUM_SOM_PRATHER ) = 1
78 GAD_Scheme_olSize( ENUM_SOM_LIMITER ) = 1
79 C- Initialise overlap minimum size for GAD pkg:
80 GAD_OlMinSize(1) = 0
81 GAD_OlMinSize(2) = 0
82 GAD_OlMinSize(3) = 1
83
84 C- Set SOM I/O suffix (used for pickup, diagnostics ...)
85 DO n=1,nSOM
86 somSfx(n) = ' '
87 IF (n.EQ.1) somSfx(n) = '_x'
88 IF (n.EQ.2) somSfx(n) = '_y'
89 IF (n.EQ.3) somSfx(n) = '_z'
90 IF (n.EQ.4) somSfx(n) = 'xx'
91 IF (n.EQ.5) somSfx(n) = 'yy'
92 IF (n.EQ.6) somSfx(n) = 'zz'
93 IF (n.EQ.7) somSfx(n) = 'xy'
94 IF (n.EQ.8) somSfx(n) = 'xz'
95 IF (n.EQ.9) somSfx(n) = 'yz'
96 ENDDO
97
98 C-- Check that Temp & Salt have valid advection scheme number:
99 validNum = GAD_VALID_ADVSCHEME(tempAdvScheme)
100 IF ( .NOT.validNum ) THEN
101 WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED:',
102 & ' invalid Temp. advection scheme number=', tempAdvScheme
103 CALL PRINT_ERROR( msgBuf, myThid )
104 STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
105 ENDIF
106 validNum = GAD_VALID_ADVSCHEME(tempVertAdvScheme)
107 IF ( .NOT.validNum ) THEN
108 WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED:',
109 & ' invalid Temp. Vert. Adv.scheme number=', tempVertAdvScheme
110 CALL PRINT_ERROR( msgBuf, myThid )
111 STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
112 ENDIF
113 validNum = GAD_VALID_ADVSCHEME(saltAdvScheme)
114 IF ( .NOT.validNum ) THEN
115 WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED:',
116 & ' invalid Salt. advection scheme number=', saltAdvScheme
117 CALL PRINT_ERROR( msgBuf, myThid )
118 STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
119 ENDIF
120 validNum = GAD_VALID_ADVSCHEME(saltVertAdvScheme)
121 IF ( .NOT.validNum ) THEN
122 WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED:',
123 & ' invalid Salt. Vert. Adv.scheme number=', saltVertAdvScheme
124 CALL PRINT_ERROR( msgBuf, myThid )
125 STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
126 ENDIF
127
128 C-- Set Temp & Salt 2nd-Order Moment Advec. flag according to advection scheme
129 tempSOM_Advection = tempAdvScheme.GE.ENUM_SOM_PRATHER
130 & .AND. tempAdvScheme.LE.ENUM_SOM_LIMITER
131 tempSOM_Advection = tempSOM_Advection .AND. tempAdvection
132 saltSOM_Advection = saltAdvScheme.GE.ENUM_SOM_PRATHER
133 & .AND. saltAdvScheme.LE.ENUM_SOM_LIMITER
134 saltSOM_Advection = saltSOM_Advection .AND. saltAdvection
135
136 C-- Set Temp & Salt multi-Dim Advec. flag according to advection scheme used
137 tempMultiDimAdvec = multiDimAdvection .AND. tempAdvection
138 saltMultiDimAdvec = multiDimAdvection .AND. saltAdvection
139 IF ( tempAdvScheme.EQ.ENUM_CENTERED_2ND
140 & .OR.tempAdvScheme.EQ.ENUM_UPWIND_3RD
141 & .OR.tempAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
142 tempMultiDimAdvec = .FALSE.
143 ENDIF
144 IF ( saltAdvScheme.EQ.ENUM_CENTERED_2ND
145 & .OR.saltAdvScheme.EQ.ENUM_UPWIND_3RD
146 & .OR.saltAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
147 saltMultiDimAdvec = .FALSE.
148 ENDIF
149
150 C-- Set general multi-Dim Advec. flag when at least 1 tracer use multi-Dim Advec.
151 useMultiDimAdvec = useMultiDimAdvec.OR.tempMultiDimAdvec
152 useMultiDimAdvec = useMultiDimAdvec.OR.saltMultiDimAdvec
153
154 C-- Set Temp & Salt Adams-Bashforth flag according to advection scheme used
155 AdamsBashforthGt = .FALSE.
156 AdamsBashforthGs = .FALSE.
157 AdamsBashforth_T = .FALSE.
158 AdamsBashforth_S = .FALSE.
159 IF ( tempAdvScheme.EQ.ENUM_CENTERED_2ND
160 & .OR.tempAdvScheme.EQ.ENUM_UPWIND_3RD
161 & .OR.tempAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
162 AdamsBashforthGt = tempStepping
163 ENDIF
164 IF ( saltAdvScheme.EQ.ENUM_CENTERED_2ND
165 & .OR.saltAdvScheme.EQ.ENUM_UPWIND_3RD
166 & .OR.saltAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
167 AdamsBashforthGs = saltStepping
168 ENDIF
169 #ifdef ALLOW_ADAMSBASHFORTH_3
170 C- For now, A-B on T,S is only implemented in AB-3 code, and not working
171 C with synchronous time-step, which would require to do also AB(u,v,w)
172 IF ( .NOT.doAB_onGtGs .AND.
173 & (staggerTimeStep .OR. implicitIntGravWave) ) THEN
174 AdamsBashforth_T = AdamsBashforthGt
175 AdamsBashforth_S = AdamsBashforthGs
176 AdamsBashforthGt = .FALSE.
177 AdamsBashforthGs = .FALSE.
178 ENDIF
179 #endif /* ALLOW_ADAMSBASHFORTH_3 */
180
181 #ifdef GAD_SMOLARKIEWICZ_HACK
182 SmolarkiewiczMaxFrac = 1. _d 0
183 #endif
184
185 C-- Set Overlap minimum size according to Temp & Salt advection
186 IF ( tempAdvection ) THEN
187 GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1),
188 & GAD_Scheme_olSize(tempAdvScheme) )
189 ENDIF
190 IF ( saltAdvection ) THEN
191 GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1),
192 & GAD_Scheme_olSize(saltAdvScheme) )
193 ENDIF
194 IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
195 C- multi-dim-advection on CS-grid requires to double the size of Olx,Oly
196 GAD_OlMinSize(3) = MAX( GAD_OlMinSize(3), 2 )
197 ENDIF
198 WRITE(msgBuf,'(A,9I3)')
199 & 'GAD_INIT_FIXED: GAD_OlMinSize=', GAD_OlMinSize
200 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
201
202 _END_MASTER(myThid)
203
204 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
205
206 #ifdef ALLOW_DIAGNOSTICS
207 IF ( useDiagnostics ) THEN
208 C-- Add diagnostics of Temp & Salt fluxes to the (long) list of diagnostics:
209 CALL GAD_DIAGNOSTICS_INIT( myThid )
210 ENDIF
211 #endif /* ALLOW_DIAGNOSTICS */
212
213 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
214
215 C-- Print out GAD parameters :
216 _BEGIN_MASTER(myThid)
217
218 WRITE(msgBuf,'(A)') ' '
219 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
220 WRITE(msgBuf,'(A)') '// ==================================='
221 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
222 WRITE(msgBuf,'(A)')'// GAD parameters :'
223 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
224 WRITE(msgBuf,'(A)') '// ==================================='
225 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
226
227 CALL WRITE_0D_I( tempAdvScheme, INDEX_NONE,
228 & 'tempAdvScheme =',
229 & ' /* Temp. Horiz.Advection scheme selector */')
230 CALL WRITE_0D_I( tempVertAdvScheme, INDEX_NONE,
231 & 'tempVertAdvScheme =',
232 & ' /* Temp. Vert. Advection scheme selector */')
233 CALL WRITE_0D_L( tempMultiDimAdvec, INDEX_NONE,
234 & 'tempMultiDimAdvec =',
235 & ' /* use Muti-Dim Advec method for Temp */')
236 CALL WRITE_0D_L( tempSOM_Advection, INDEX_NONE,
237 & 'tempSOM_Advection =',
238 & ' /* use 2nd Order Moment Advection for Temp */')
239 CALL WRITE_0D_L( AdamsBashforthGt, INDEX_NONE,
240 & 'AdamsBashforthGt =',
241 & ' /* apply Adams-Bashforth extrapolation on Gt */')
242 CALL WRITE_0D_L( AdamsBashforth_T, INDEX_NONE,
243 & 'AdamsBashforth_T =',
244 & ' /* apply Adams-Bashforth extrapolation on Temp */')
245
246 CALL WRITE_0D_I( saltAdvScheme, INDEX_NONE,
247 & 'saltAdvScheme =',
248 & ' /* Salt. Horiz.advection scheme selector */')
249 CALL WRITE_0D_I( saltVertAdvScheme, INDEX_NONE,
250 & 'saltVertAdvScheme =',
251 & ' /* Salt. Vert. Advection scheme selector */')
252 CALL WRITE_0D_L( saltMultiDimAdvec, INDEX_NONE,
253 & 'saltMultiDimAdvec =',
254 & ' /* use Muti-Dim Advec method for Salt */')
255 CALL WRITE_0D_L( saltSOM_Advection, INDEX_NONE,
256 & 'saltSOM_Advection =',
257 & ' /* use 2nd Order Moment Advection for Salt */')
258 CALL WRITE_0D_L( AdamsBashforthGs, INDEX_NONE,
259 & 'AdamsBashforthGs =',
260 & ' /* apply Adams-Bashforth extrapolation on Gs */')
261 CALL WRITE_0D_L( AdamsBashforth_S, INDEX_NONE,
262 & 'AdamsBashforth_S =',
263 & ' /* apply Adams-Bashforth extrapolation on Salt */')
264 #ifdef GAD_SMOLARKIEWICZ_HACK
265 CALL WRITE_0D_RL( SmolarkiewiczMaxFrac, INDEX_NONE,
266 & 'SmolarkiewiczMaxFrac =',
267 & ' /* maximal fraction of tracer to flow out of a cell */')
268 #endif
269
270 WRITE(msgBuf,'(A)') '// ==================================='
271 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
272
273 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
274
275 _END_MASTER(myThid)
276 _BARRIER
277
278 RETURN
279 END

  ViewVC Help
Powered by ViewVC 1.1.22