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

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

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


Revision 1.1 - (hide annotations) (download)
Fri May 30 21:51:23 2008 UTC (17 years, 1 month ago) by dimitri
Branch: MAIN
This is the code from pkg/gmredi (checkpoint59r) on which Baylor based
his submesoscale parameterization.

1 dimitri 1.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 ALLOW_PTRACERS
135     IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
136     & .AND. usePTRACERS ) THEN
137     redFlag = .FALSE.
138     DO iTr=1,PTRACERS_numInUse
139     IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN
140     redFlag = .TRUE.
141     WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:',
142     & ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr)
143     CALL PRINT_ERROR( msgBuf, myThid )
144     ENDIF
145     ENDDO
146     IF ( redFlag ) THEN
147     WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:',
148     & ' but GM Advective Form applies to all tracers !'
149     CALL PRINT_ERROR( msgBuf, myThid )
150     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
151     ENDIF
152     ENDIF
153     #endif /* ALLOW_PTRACERS */
154    
155     #ifdef ALLOW_GENERIC_ADVDIFF
156     C Check size of overlap region
157     IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
158     & .AND. GM_Visbeck_alpha.NE.0.
159     & .AND. useMultiDimAdvec
160     & .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN
161     C Visbeck variable K requires 1 more row/column in the overlap:
162     C might need to increase Olx,Oly from 2 to 3 if GM advective
163     C form & multi-dim advection are used. This happens when:
164     C a) using a 5 points stencil advection scheme ; or
165     C b) using a 3 points stencil advection scheme on CS-grid
166     C note: not clear how to check (b) since none of the advection scheme
167     C currently implemented falls in this category, except if
168     C GAD_FLUX_LIMITER.h is changed to use a "constant" flux-limiter
169     C (from Lax-Wendroff to 1rst Order upwind).
170     C-------
171     c IF ( (useCubedSphereExchange
172     c & .AND.( tempAdvScheme.EQ.ENUM_LAXWENDROFF
173     c & .OR. saltAdvScheme.EQ.ENUM_LAXWENDROFF )
174     c & ).OR.( tempAdvScheme.EQ.ENUM_FLUX_LIMIT
175     c & .OR. saltAdvScheme.EQ.ENUM_FLUX_LIMIT
176     c & .OR. tempAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
177     c & .OR. saltAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
178     c & .OR. tempAdvScheme.EQ.ENUM_DST3
179     c & .OR. saltAdvScheme.EQ.ENUM_DST3 )
180     c & ) THEN
181     WRITE(msgBuf,'(A,A)')
182     & 'GMREDI_CHECK: Visbeck + GM_AdvForm in MultiDimAdvec'
183     CALL PRINT_ERROR( msgBuf , myThid )
184     WRITE(msgBuf,'(A)') 'GMREDI_CHECK: need at least Olx,Oly = 3'
185     CALL PRINT_ERROR( msgBuf , myThid )
186     STOP 'ABNORMAL END: S/R GMREDI_CHECK'
187     c ENDIF
188     ENDIF
189     #endif /* ALLOW_GENERIC_ADVDIFF */
190    
191     _END_MASTER(myThid)
192    
193     #endif /* ALLOW_GMREDI */
194     RETURN
195     END

  ViewVC Help
Powered by ViewVC 1.1.22