/[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.10 by jmc, Wed Nov 12 03:58:48 2003 UTC revision 1.16 by gforget, Fri May 30 02:50:16 2008 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "GMREDI_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  #include "GAD.h"  #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  
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 :  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_R8( 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_R8( 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_R8( 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_R8( GM_Visbeck_alpha, INDEX_NONE,
78       &  ' GM_Visbeck_alpha =','   /* Visbeck alpha coeff. ( ) */')             &  ' GM_Visbeck_alpha =','   /* Visbeck alpha coeff. ( ) */')
79         WRITE(msgBuf,'(A,A40)')' Tapering/Cliping : ',GM_taper_scheme         WRITE(msgBuf,'(A,A40)')' Tapering/Cliping : ',GM_taper_scheme
80         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
81         &                     SQUEEZE_RIGHT, myThid )
82         CALL WRITE_0D_R8( GM_Small_Number, INDEX_NONE,         CALL WRITE_0D_R8( GM_Small_Number, INDEX_NONE,
83       &  ' GM_Small_Number =','  /* epsilon used in slope calc */')             &  ' GM_Small_Number =','  /* epsilon used in slope calc */')
84         CALL WRITE_0D_R8( GM_slopeSqCutoff, INDEX_NONE,         CALL WRITE_0D_R8( GM_slopeSqCutoff, INDEX_NONE,
85       &  ' GM_slopeSqCutoff =', '  /* Slope^2 cut-off value */')             &  ' GM_slopeSqCutoff =', '  /* Slope^2 cut-off value */')
86    
87    
88  C--  Check parameters:  C--  Check parameters:
89    
       _BEGIN_MASTER(myThid)  
   
90  C-     GM/Redi needs implicit diffusion (will be packaged later)  C-     GM/Redi needs implicit diffusion (will be packaged later)
91         IF (.NOT.implicitDiffusion) THEN        IF ( .NOT.implicitDiffusion ) THEN
92          WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'          WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.'
93          CALL PRINT_ERROR( msgBuf , 1)          CALL PRINT_ERROR( msgBuf , myThid )
94          STOP 'ABNORMAL END: S/R GMREDI_CHECK'          STOP 'ABNORMAL END: S/R GMREDI_CHECK'
95         ENDIF        ENDIF
96    
97  #ifndef GM_VISBECK_VARIABLE_K  #ifndef GM_VISBECK_VARIABLE_K
98  C     Make sure we are not trying to use something that is unavailable  C     Make sure we are not trying to use something that is unavailable
99        IF (GM_Visbeck_alpha .NE. 0.) THEN        IF ( GM_Visbeck_alpha.NE.0. ) THEN
100         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
101       &   ' GMREDI_CHECK: Visbeck variables used in data.gmredi'       &   ' GMREDI_CHECK: Visbeck variables used in data.gmredi'
102         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
103         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
104       &   ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K'       &   ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K'
105         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
106         STOP 'ABNORMAL END: S/R GMREDI_CHECK'         STOP 'ABNORMAL END: S/R GMREDI_CHECK'
107        ENDIF        ENDIF
108  #endif  #endif
109    
110  #ifndef GM_BOLUS_ADVEC  #ifndef GM_BOLUS_ADVEC
111  C     Make sure we are not trying to use some arrays that are unavailable  C     Make sure we are not trying to use some arrays that are unavailable
112        IF (GM_AdvForm) THEN        IF ( GM_AdvForm ) THEN
113         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
114       &   ' GMREDI_CHECK: GM Advection form used in data.gmredi'       &   ' GMREDI_CHECK: GM Advection form used in data.gmredi'
115         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
116         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
117       &   ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC'       &   ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC'
118         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
119         STOP 'ABNORMAL END: S/R GMREDI_CHECK'         STOP 'ABNORMAL END: S/R GMREDI_CHECK'
120        ENDIF        ENDIF
121  #endif  #endif
122    
123  #ifndef GM_EXTRA_DIAGONAL  #ifndef GM_EXTRA_DIAGONAL
124  C     Make sure we are not trying to use some arrays that are unavailable  C     Make sure we are not trying to use some arrays that are unavailable
125        IF (GM_ExtraDiag) THEN        IF ( GM_ExtraDiag ) THEN
126         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
127       &   ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal'       &   ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal'
128         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
129         WRITE(msgBuf,'(A)')         WRITE(msgBuf,'(A)')
130       &   ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL'       &   ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL'
131         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, myThid )
132         STOP 'ABNORMAL END: S/R GMREDI_CHECK'         STOP 'ABNORMAL END: S/R GMREDI_CHECK'
133        ENDIF        ENDIF
134  #endif  #endif
135    
136    #ifdef ALLOW_PTRACERS
137        IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate        IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
138       &       .AND. (tempMultiDimAdvec.OR.saltMultiDimAdvec)       &       .AND. usePTRACERS ) THEN
139            redFlag = .FALSE.
140            DO iTr=1,PTRACERS_numInUse
141             IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN
142              redFlag = .TRUE.
143              WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:',
144         &     ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr)
145              CALL PRINT_ERROR( msgBuf, myThid )
146             ENDIF
147            ENDDO
148            IF ( redFlag ) THEN
149              WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:',
150         &     ' but GM Advective Form applies to all tracers !'
151              CALL PRINT_ERROR( msgBuf, myThid )
152              STOP 'ABNORMAL END: S/R GMREDI_CHECK'
153            ENDIF
154          ENDIF
155    #endif /* ALLOW_PTRACERS */
156    
157    #ifdef ALLOW_GENERIC_ADVDIFF
158    C     Check size of overlap region
159          IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
160         &       .AND. GM_Visbeck_alpha.NE.0.
161         &       .AND. useMultiDimAdvec
162       &       .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN       &       .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN
163  C note: a) this is a practical limitation. In theory, WITHOUT Visbeck,  C       Visbeck variable K requires 1 more row/column in the overlap:
164  C       changing some loop indices would make it works with Olx=Oly=2  C       might need to increase Olx,Oly from 2 to 3 if GM advective
165  C       b) we really need 1 flag (like multiDimAdvection) that tells  C       form & multi-dim advection are used. This happens when:
166  C       if a least 1 tracer is using a multi-Dim advection scheme.  C       a) using a 5 points stencil advection scheme ; or
167          WRITE(msgBuf,'(A,2I3,A)')  C       b) using a 3 points stencil advection scheme on CS-grid
168       &  'GMREDI_CHECK: Olx,Oly WRONG: cannot use those AdvScheme (',  C note: not clear how to check (b) since none of the advection scheme
169       &     tempAdvScheme, saltAdvScheme, ') '  C       currently implemented falls in this category, except if
170          CALL PRINT_ERROR( msgBuf , myThid)  C       GAD_FLUX_LIMITER.h is changed to use a "constant" flux-limiter
171          WRITE(msgBuf,'(A,A)')  C       (from Lax-Wendroff to 1rst Order upwind).
172       &  'GMREDI_CHECK: and GM_AdvForm(not_Separate) with',  C-------
173       &  ' (Olx,Oly) smaller than 3'  c       IF ( (useCubedSphereExchange
174          CALL PRINT_ERROR( msgBuf , myThid)  c    &       .AND.(    tempAdvScheme.EQ.ENUM_LAXWENDROFF
175          STOP 'ABNORMAL END: S/R GMREDI_CHECK'  c    &            .OR. saltAdvScheme.EQ.ENUM_LAXWENDROFF )
176    c    &       ).OR.(    tempAdvScheme.EQ.ENUM_FLUX_LIMIT
177    c    &            .OR. saltAdvScheme.EQ.ENUM_FLUX_LIMIT
178    c    &            .OR. tempAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
179    c    &            .OR. saltAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT
180    c    &            .OR. tempAdvScheme.EQ.ENUM_DST3
181    c    &            .OR. saltAdvScheme.EQ.ENUM_DST3 )
182    c    &     ) THEN
183              WRITE(msgBuf,'(A,A)')
184         &     'GMREDI_CHECK: Visbeck + GM_AdvForm in MultiDimAdvec'
185              CALL PRINT_ERROR( msgBuf , myThid )
186              WRITE(msgBuf,'(A)') 'GMREDI_CHECK: need at least Olx,Oly = 3'
187              CALL PRINT_ERROR( msgBuf , myThid )
188              STOP 'ABNORMAL END: S/R GMREDI_CHECK'
189    c       ENDIF
190        ENDIF        ENDIF
191    #endif /* ALLOW_GENERIC_ADVDIFF */
192    
193        _END_MASTER(myThid)        _END_MASTER(myThid)
194    
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22