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

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

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

revision 1.4 by cnh, Sun Feb 4 14:38:49 2001 UTC revision 1.14 by jmc, Tue Sep 18 21:24:13 2007 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #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 )        SUBROUTINE GMREDI_CHECK( myThid )
13  C     /==========================================================\  
14  C     | SUBROUTINE GMREDI_CHECK                                  |  C     !DESCRIPTION: \bv
15  C     | o Check dependances with other packages                  |  C     *==========================================================*
16  C     |==========================================================|  C     | SUBROUTINE GMREDI_CHECK
17  C     \==========================================================/  C     | o Check consistency with model configuration
18    C     *==========================================================*
19    C     *==========================================================*
20    C     \ev
21    
22    C     !USES:
23        IMPLICIT NONE        IMPLICIT NONE
24    
25  C     === Global variables ===  C     === Global variables ===
# Line 16  C     === Global variables === Line 27  C     === Global variables ===
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GMREDI.h"  #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.h"
36    #endif
37    
38    C     !INPUT/OUTPUT PARAMETERS:
39  C     === Routine arguments ===  C     === Routine arguments ===
40  C     myThid -  Number of this instances  C     myThid :: my Thread Id number
41        INTEGER myThid        INTEGER myThid
42    
43    #ifdef ALLOW_GMREDI
44    C     !LOCAL VARIABLES:
45  C     === Local variables ===  C     === Local variables ===
46  C     msgBuf      - Informational/error meesage buffer  C     msgBuf :: Informational/error meesage buffer
47        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
48    CEOP
49    #ifdef ALLOW_PTRACERS
50          INTEGER iTr
51          LOGICAL redFlag
52    #endif
53    
54          _BEGIN_MASTER(myThid)
 #ifdef ALLOW_GMREDI  
       IF (GMRediIsOn) THEN  
55    
56         WRITE(msgBuf,'(A)') 'GMREDI_CHECK: #define GMREDI'         WRITE(msgBuf,'(A)') 'GMREDI_CHECK: #define GMREDI'
57         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
58       &                    SQUEEZE_RIGHT , 1)       &                     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)  C-     GM/Redi needs implicit diffusion (will be packaged later)
89         IF (.NOT.implicitDiffusion) THEN        IF ( .NOT.implicitDiffusion ) THEN
90          WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'          WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'
91          CALL PRINT_ERROR( msgBuf , 1)          CALL PRINT_ERROR( msgBuf , myThid )
92          STOP 'ABNORMAL END: S/R GMREDI_CHECK'          STOP 'ABNORMAL END: S/R GMREDI_CHECK'
93         ENDIF        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        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  #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        RETURN
195        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22