pkg/generic_advdiff/gad_check.F

d7ce0d34f8 Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: GAD_CHECK
                0005 C     !INTERFACE:
                0006       SUBROUTINE GAD_CHECK( myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE GAD_CHECK
                0011 C     | o Check consistency with model configuration
                0012 C     *==========================================================*
                0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GAD.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     === Routine arguments ===
                0027 C     myThid :: my Thread Id number
                0028       INTEGER myThid
                0029
                0030 #ifdef ALLOW_GENERIC_ADVDIFF
                0031 C     !LOCAL VARIABLES:
                0032 C     === Local variables ===
c3cd6c250f Jean*0033 C     msgBuf :: Informational/error message buffer
d7ce0d34f8 Jean*0034       CHARACTER*(MAX_LEN_MBUF) msgBuf
26e9727e55 Jean*0035       INTEGER minOlSize, n
46918f1b26 Jean*0036       INTEGER errCount
d7ce0d34f8 Jean*0037 CEOP
                0038
                0039       _BEGIN_MASTER(myThid)
46918f1b26 Jean*0040       errCount = 0
d7ce0d34f8 Jean*0041
                0042        WRITE(msgBuf,'(A)') 'GAD_CHECK: #define ALLOW_GENERIC_ADVDIFF'
                0043        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0044      &                     SQUEEZE_RIGHT , myThid )
                0045
                0046 C--  Print out some kee parameters :
c3cd6c250f Jean*0047 C    (better chance to know why it is stopping if print first & check after)
d7ce0d34f8 Jean*0048
                0049 C--  Check Options:
                0050 #ifdef DISABLE_MULTIDIM_ADVECTION
                0051 c     IF ( useMultiDimAdvec ) THEN
                0052       IF ( useMultiDimAdvec .OR.
                0053      &     tempSOM_Advection .OR. saltSOM_Advection
                0054      &   ) THEN
                0055         WRITE(msgBuf,'(2A)') 'GAD_CHECK: ',
                0056      &  'trying to use Multi-Dim. Advection code that is not compiled'
46918f1b26 Jean*0057         CALL PRINT_ERROR( msgBuf, myThid )
                0058         WRITE(msgBuf,'(2A)') 'GAD_CHECK: Re-compile with: ',
                0059      &    ' #undef DISABLE_MULTIDIM_ADVECTION in GAD_OPTIONS.h'
                0060         CALL PRINT_ERROR( msgBuf, myThid )
                0061         errCount = errCount + 1
d7ce0d34f8 Jean*0062       ENDIF
                0063 #endif /* DISABLE_MULTIDIM_ADVECTION */
                0064
6e23417f74 Jean*0065 #ifndef GAD_ALLOW_TS_SOM_ADV
d7ce0d34f8 Jean*0066       IF ( tempAdvScheme.EQ.ENUM_SOM_PRATHER
                0067      & .OR.saltAdvScheme.EQ.ENUM_SOM_PRATHER
                0068      & .OR.tempAdvScheme.EQ.ENUM_SOM_LIMITER
                0069      & .OR.saltAdvScheme.EQ.ENUM_SOM_LIMITER ) THEN
                0070         WRITE(msgBuf,'(2A)') 'GAD_CHECK: ',
                0071      &  'trying to use 2nd.Order-Moment Advection that is not compiled'
46918f1b26 Jean*0072         CALL PRINT_ERROR( msgBuf, myThid )
                0073         WRITE(msgBuf,'(2A)') 'GAD_CHECK: Re-compile with: ',
                0074      &    ' #define GAD_ALLOW_TS_SOM_ADV in GAD_OPTIONS.h'
                0075         CALL PRINT_ERROR( msgBuf, myThid )
                0076         errCount = errCount + 1
                0077       ENDIF
                0078 #endif /* ndef GAD_ALLOW_TS_SOM_ADV */
                0079
                0080 #ifndef GAD_SMOLARKIEWICZ_HACK
                0081       IF ( temp_stayPositive .OR. salt_stayPositive ) THEN
d7ce0d34f8 Jean*0082         WRITE(msgBuf,'(2A)') 'GAD_CHECK: ',
46918f1b26 Jean*0083      &  'Smolarkiewicz Hack code (to keep T/S positive) is not compiled'
                0084         CALL PRINT_ERROR( msgBuf, myThid )
                0085         WRITE(msgBuf,'(2A)') 'GAD_CHECK: Re-compile with: ',
                0086      &    ' #define GAD_SMOLARKIEWICZ_HACK in GAD_OPTIONS.h'
d7ce0d34f8 Jean*0087         CALL PRINT_ERROR( msgBuf , myThid)
46918f1b26 Jean*0088         errCount = errCount + 1
d7ce0d34f8 Jean*0089       ENDIF
46918f1b26 Jean*0090 #endif /* ndef GAD_SMOLARKIEWICZ_HACK */
d7ce0d34f8 Jean*0091
                0092 C--  Check parameters:
                0093
b4f60a0901 Jean*0094 C--  Check internal wave dynamics stability regarding active tracer time-stepping
bcb71b77cb Jean*0095       IF ( .NOT.(staggerTimeStep.OR.implicitIntGravWave) ) THEN
                0096         IF ( ( tempIsActiveTr .AND. .NOT.AdamsBashforthGt )
                0097      &  .OR. ( saltIsActiveTr .AND. .NOT.AdamsBashforthGs ) ) THEN
333346b5de Jean*0098 C-      issue a warning in Error msg file:
                0099            WRITE(msgBuf,'(2A)') '** WARNING ** GAD_CHECK: ',
                0100      &       'potentially unstable time-stepping (Internal Wave)'
                0101            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0102      &                         SQUEEZE_RIGHT , myThid)
                0103            WRITE(msgBuf,'(2A)') '** WARNING ** GAD_CHECK: ',
                0104      &       'need "staggerTimeStep=.TRUE." in "data", nml PARM01'
                0105            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0106      &                         SQUEEZE_RIGHT , myThid)
                0107         ENDIF
                0108       ENDIF
                0109
26e9727e55 Jean*0110 C--   Check size of overlap region
                0111 C--   Note: checking minimum size of overlap due to tracer limitations moved here;
                0112 C     previously done in GAD_INIT_FIXED, PTRACERS_INIT_FIXED and GMREDI_CHECK;
d7ce0d34f8 Jean*0113 C     for mom limitations, done in CONFIG_CHECK, but can move to MOM_INIT_FIXED
26e9727e55 Jean*0114
                0115       minOlSize = MAX( GAD_OlMinSize(1)+GAD_OlMinSize(2),
                0116      &                 GAD_OlMinSize(2)+GAD_OlMinSize(3),
                0117      &                 GAD_OlMinSize(1)*GAD_OlMinSize(3) )
64442af1fe Jean*0118       IF ( OLx.LT.minOlSize .OR. OLy.LT.minOlSize ) THEN
                0119         WRITE(msgBuf,'(A,2I3,A)') 'GAD_CHECK: Overlap Size OLx,OLy=',
                0120      &                             OLx, OLy,' too small'
26e9727e55 Jean*0121         CALL PRINT_ERROR( msgBuf, myThid )
                0122         WRITE(msgBuf,'(2A)') 'GAD_CHECK: ',
                0123      &     'One tracer (T,S,pTrac, ...) advection scheme'
                0124         CALL PRINT_ERROR( msgBuf, myThid )
                0125         WRITE(msgBuf,'(2A,I3,A,3I2,A)') 'GAD_CHECK: ',
64442af1fe Jean*0126      &     'needs at least OLx,OLy=', minOlSize,
26e9727e55 Jean*0127      &     ' (OlMinSize=', (GAD_OlMinSize(n),n=1,3), ')'
                0128         CALL PRINT_ERROR( msgBuf, myThid )
46918f1b26 Jean*0129         errCount = errCount + 1
d7ce0d34f8 Jean*0130       ENDIF
                0131
24fb6044b7 Patr*0132 C Check compatibility with adjoint
64442af1fe Jean*0133 #ifdef ALLOW_AUTODIFF
598aebfcee Mart*0134       IF ( tempAdvScheme.EQ.ENUM_PPM_NULL_LIMIT .OR.
                0135      &     tempAdvScheme.EQ.ENUM_PPM_MONO_LIMIT .OR.
                0136      &     tempAdvScheme.EQ.ENUM_PPM_WENO_LIMIT ) THEN
                0137         WRITE(msgBuf,'(A,3(I3,A))') 'GAD_CHECK: tempAdvection =',
                0138      &      ENUM_PPM_NULL_LIMIT, ',', ENUM_PPM_MONO_LIMIT, ', and',
                0139      &      ENUM_PPM_WENO_LIMIT,
                0140      &   ' are not yet implemented for adjoint'
                0141         CALL PRINT_ERROR( msgBuf, myThid )
                0142         errCount = errCount + 1
                0143       ENDIF
                0144       IF ( tempAdvScheme.EQ.ENUM_PQM_NULL_LIMIT .OR.
                0145      &     tempAdvScheme.EQ.ENUM_PQM_MONO_LIMIT .OR.
                0146      &     tempAdvScheme.EQ.ENUM_PQM_WENO_LIMIT ) THEN
                0147         WRITE(msgBuf,'(A,3(I3,A))') 'GAD_CHECK: tempAdvection =',
                0148      &      ENUM_PQM_NULL_LIMIT, ',', ENUM_PQM_MONO_LIMIT, ', and',
                0149      &      ENUM_PQM_WENO_LIMIT,
                0150      &   ' are not yet implemented for adjoint'
                0151         CALL PRINT_ERROR( msgBuf, myThid )
                0152         errCount = errCount + 1
                0153       ENDIF
                0154       IF ( saltAdvScheme.EQ.ENUM_PPM_NULL_LIMIT .OR.
                0155      &     saltAdvScheme.EQ.ENUM_PPM_MONO_LIMIT .OR.
                0156      &     saltAdvScheme.EQ.ENUM_PPM_WENO_LIMIT ) THEN
                0157         WRITE(msgBuf,'(A,3(I3,A))') 'GAD_CHECK: saltAdvection =',
                0158      &      ENUM_PPM_NULL_LIMIT, ',', ENUM_PPM_MONO_LIMIT, ', and',
                0159      &      ENUM_PPM_WENO_LIMIT,
                0160      &   ' are not yet implemented for adjoint'
                0161         CALL PRINT_ERROR( msgBuf, myThid )
                0162         errCount = errCount + 1
                0163       ENDIF
                0164       IF ( saltAdvScheme.EQ.ENUM_PQM_NULL_LIMIT .OR.
                0165      &     saltAdvScheme.EQ.ENUM_PQM_MONO_LIMIT .OR.
                0166      &     saltAdvScheme.EQ.ENUM_PQM_WENO_LIMIT ) THEN
                0167         WRITE(msgBuf,'(A,3(I3,A))') 'GAD_CHECK: saltAdvection =',
                0168      &      ENUM_PQM_NULL_LIMIT, ',', ENUM_PQM_MONO_LIMIT, ', and',
                0169      &      ENUM_PQM_WENO_LIMIT,
                0170      &   ' are not yet implemented for adjoint'
24fb6044b7 Patr*0171         CALL PRINT_ERROR( msgBuf, myThid )
46918f1b26 Jean*0172         errCount = errCount + 1
24fb6044b7 Patr*0173       ENDIF
64442af1fe Jean*0174 #endif /* ALLOW_AUTODIFF */
24fb6044b7 Patr*0175
46918f1b26 Jean*0176       IF ( errCount.GE.1 ) THEN
                0177         WRITE(msgBuf,'(A,I3,A)')
                0178      &       'GAD_CHECK: detected', errCount,' fatal error(s)'
                0179         CALL PRINT_ERROR( msgBuf, myThid )
                0180         CALL ALL_PROC_DIE( 0 )
                0181         STOP 'ABNORMAL END: S/R GAD_CHECK'
                0182       ENDIF
                0183
d7ce0d34f8 Jean*0184       _END_MASTER(myThid)
                0185
                0186 #endif /* ALLOW_GENERIC_ADVDIFF */
                0187       RETURN
                0188       END