/[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.6 by jmc, Wed Mar 6 01:56:27 2002 UTC revision 1.18 by jmc, Tue Apr 28 23:27:24 2009 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_PARAMS.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 )
   
 C      GM/Redi needs implicit diffusion (will be packaged later)  
        IF (.NOT.implicitDiffusion) THEN  
         WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'  
         CALL PRINT_ERROR( msgBuf , 1)  
         STOP 'ABNORMAL END: S/R GMREDI_CHECK'  
        ENDIF  
59    
60  C- print out some kee parameters :  C- print out some kee parameters :
61         CALL WRITE_0D_L( GM_AdvForm, INDEX_NONE,         CALL WRITE_0D_L( GM_AdvForm, INDEX_NONE,
62       &  'GM_AdvForm =', '  /* if FALSE => use SkewFlux Form */')           &  'GM_AdvForm =', '     /* if FALSE => use SkewFlux Form */')
63           CALL WRITE_0D_L( GM_InMomAsStress, INDEX_NONE,
64         &  'GM_InMomAsStress =', ' /* if TRUE => apply as Eddy Stress */')
65         CALL WRITE_0D_L( GM_AdvSeparate, INDEX_NONE,         CALL WRITE_0D_L( GM_AdvSeparate, INDEX_NONE,
66       & 'GM_AdvSeparate =',' /* Calc Bolus & Euler Adv. separately */')           & 'GM_AdvSeparate =',' /* Calc Bolus & Euler Adv. separately */')
67         CALL WRITE_0D_L( GM_ExtraDiag, INDEX_NONE,         CALL WRITE_0D_L( GM_ExtraDiag, INDEX_NONE,
68       &  'GM_ExtraDiag =','  /* Tensor Extra Diag (line 1&2) non 0 */')       &  'GM_ExtraDiag =','   /* Tensor Extra Diag (line 1&2) non 0 */')
69         CALL WRITE_0D_R8( GM_isopycK, INDEX_NONE,'GM_isopycK =',         CALL WRITE_0D_RL( GM_isopycK, INDEX_NONE, 'GM_isopycK =',
70       &  '   /* Background Isopyc. Diffusivity ( m^2/s ) */')             &  '    /* Background Isopyc. Diffusivity [m^2/s] */')
71         CALL WRITE_0D_R8( GM_background_K*GM_skewflx, INDEX_NONE,         CALL WRITE_0D_RL( GM_background_K*GM_skewflx, INDEX_NONE,
72       &  ' GM_skewflx*K =',       &  'GM_skewflx*K =',
73       &  '   /* Background GM_SkewFlx Diffusivity ( m^2/s ) */')             &  '  /* Background GM_SkewFlx Diffusivity [m^2/s] */')
74         CALL WRITE_0D_R8( GM_background_K*GM_advect, INDEX_NONE,         CALL WRITE_0D_RL( GM_background_K*GM_advect, INDEX_NONE,
75       &  ' GM_advec*K =',       &  'GM_advec*K =',
76       &  '   /* Backg. GM-Advec(=Bolus) Diffusivity ( m^2/s ) */')             &  '    /* Backg. GM-Advec(=Bolus) Diffusivity [m^2/s]*/')
77         CALL WRITE_0D_R8( GM_Visbeck_alpha, INDEX_NONE,         CALL WRITE_0D_RL( GM_background_K*GM_advect, INDEX_NONE,
78       &  ' GM_Visbeck_alpha =','   /* Visbeck alpha coeff. ( ) */')             &  'GM_Kmin_horiz =',
79         WRITE(msgBuf,'(A,A40)')' Tapering/Cliping : ',GM_taper_scheme       &  ' /* Minimum Horizontal Diffusivity [m^2/s] */')
80         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)         CALL WRITE_0D_RL( GM_Visbeck_alpha, INDEX_NONE,
81         &  'GM_Visbeck_alpha =', ' /* Visbeck alpha coeff. [-] */')
82           CALL WRITE_0D_RL( GM_Small_Number, INDEX_NONE,
83         &  'GM_Small_Number =', '  /* epsilon used in slope calc */')
84           CALL WRITE_0D_RL( GM_slopeSqCutoff, INDEX_NONE,
85         &  'GM_slopeSqCutoff =', ' /* Slope^2 cut-off value */')
86           CALL WRITE_0D_C( GM_taper_scheme, 0, INDEX_NONE,
87         &  'GM_taper_scheme =',
88         &  '  /* Type of Tapering/Clipping scheme */')
89           CALL WRITE_0D_RL( GM_maxSlope, INDEX_NONE,
90         &  'GM_maxSlope =', '  /* Maximum Slope (Tapering/Clipping) */')
91           CALL WRITE_0D_RL( GM_facTrL2dz, INDEX_NONE,
92         &  'GM_facTrL2dz =',
93         &  ' /* Minimum Trans.Layer Thick. (factor of dz) */')
94           CALL WRITE_0D_RL( GM_facTrL2ML, INDEX_NONE,
95         &  'GM_facTrL2ML =',
96         &  ' /* Max.Trans.Layer Thick. (factor of MxL Depth)*/')
97           CALL WRITE_0D_RL( GM_maxTransLay, INDEX_NONE,
98         &  'GM_maxTransLay =',
99         &  ' /* Maximum Transition Layer Thickness [m] */')
100    
101    C--  Check parameters:
102    
103    C-     GM/Redi needs implicit diffusion (will be packaged later)
104          IF ( .NOT.implicitDiffusion ) THEN
105            WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'
106            CALL PRINT_ERROR( msgBuf , myThid )
107            STOP 'ABNORMAL END: S/R GMREDI_CHECK'
108          ENDIF
109    
110    #ifndef GM_VISBECK_VARIABLE_K
111    C     Make sure we are not trying to use something that is unavailable
112          IF ( GM_Visbeck_alpha.NE.0. ) THEN
113           WRITE(msgBuf,'(A)')
114         &   ' GMREDI_CHECK: Visbeck variables used in data.gmredi'
115           CALL PRINT_ERROR( msgBuf, myThid )
116           WRITE(msgBuf,'(A)')
117         &   ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K'
118           CALL PRINT_ERROR( msgBuf, myThid )
119           STOP 'ABNORMAL END: S/R GMREDI_CHECK'
120        ENDIF        ENDIF
121    #endif
122    
123    #ifndef GM_BOLUS_ADVEC
124    C     Make sure we are not trying to use some arrays that are unavailable
125          IF ( GM_AdvForm ) THEN
126           WRITE(msgBuf,'(A)')
127         &   ' GMREDI_CHECK: GM Advection form used in data.gmredi'
128           CALL PRINT_ERROR( msgBuf, myThid )
129           WRITE(msgBuf,'(A)')
130         &   ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC'
131           CALL PRINT_ERROR( msgBuf, myThid )
132           STOP 'ABNORMAL END: S/R GMREDI_CHECK'
133          ENDIF
134    #endif
135    
136    #ifndef GM_EXTRA_DIAGONAL
137    C     Make sure we are not trying to use some arrays that are unavailable
138          IF ( GM_ExtraDiag ) THEN
139           WRITE(msgBuf,'(A)')
140         &   ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal'
141           CALL PRINT_ERROR( msgBuf, myThid )
142           WRITE(msgBuf,'(A)')
143         &   ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL'
144           CALL PRINT_ERROR( msgBuf, myThid )
145           STOP 'ABNORMAL END: S/R GMREDI_CHECK'
146          ENDIF
147  #endif  #endif
148    
149    #ifdef ALLOW_PTRACERS
150          IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
151         &       .AND. usePTRACERS ) THEN
152            redFlag = .FALSE.
153            DO iTr=1,PTRACERS_numInUse
154             IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN
155              redFlag = .TRUE.
156              WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:',
157         &     ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr)
158              CALL PRINT_ERROR( msgBuf, myThid )
159             ENDIF
160            ENDDO
161            IF ( redFlag ) THEN
162              WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:',
163         &     ' but GM Advective Form applies to all tracers !'
164              CALL PRINT_ERROR( msgBuf, myThid )
165              STOP 'ABNORMAL END: S/R GMREDI_CHECK'
166            ENDIF
167          ENDIF
168    #endif /* ALLOW_PTRACERS */
169    
170    #ifdef ALLOW_GENERIC_ADVDIFF
171    C     Check size of overlap region
172          IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
173         &       .AND. GM_Visbeck_alpha.NE.0.
174         &       .AND. useMultiDimAdvec
175         &       .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN
176    C       Visbeck variable K requires 1 more row/column in the overlap:
177    C       might need to increase Olx,Oly from 2 to 3 if GM advective
178    C       form & multi-dim advection are used. This happens when:
179    C       a) using a 5 points stencil advection scheme ; or
180    C       b) using a 3 points stencil advection scheme on CS-grid
181    C note: not clear how to check (b) since none of the advection scheme
182    C       currently implemented falls in this category, except if
183    C       GAD_FLUX_LIMITER.h is changed to use a "constant" flux-limiter
184    C       (from Lax-Wendroff to 1rst Order upwind).
185    C-------
186    c       IF ( (useCubedSphereExchange
187    c    &       .AND.(    tempAdvScheme.EQ.ENUM_LAXWENDROFF
188    c    &            .OR. saltAdvScheme.EQ.ENUM_LAXWENDROFF )
189    c    &       ).OR.(    tempAdvScheme.EQ.ENUM_FLUX_LIMIT
190    c    &            .OR. saltAdvScheme.EQ.ENUM_FLUX_LIMIT
191    c    &            .OR. tempAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
192    c    &            .OR. saltAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
193    c    &            .OR. tempAdvScheme.EQ.ENUM_DST3
194    c    &            .OR. saltAdvScheme.EQ.ENUM_DST3 )
195    c    &     ) THEN
196              WRITE(msgBuf,'(A,A)')
197         &     'GMREDI_CHECK: Visbeck + GM_AdvForm in MultiDimAdvec'
198              CALL PRINT_ERROR( msgBuf , myThid )
199              WRITE(msgBuf,'(A)') 'GMREDI_CHECK: need at least Olx,Oly = 3'
200              CALL PRINT_ERROR( msgBuf , myThid )
201              STOP 'ABNORMAL END: S/R GMREDI_CHECK'
202    c       ENDIF
203          ENDIF
204    #endif /* ALLOW_GENERIC_ADVDIFF */
205    
206          _END_MASTER(myThid)
207    
208    #endif /* ALLOW_GMREDI */
209        RETURN        RETURN
210        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22