pkg/generic_advdiff/gad_advscheme.F

a9f828d17c Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 C--   File gad_advscheme.F: Keeping track of Advection schemes requirement
                0004 C--    Contents:
                0005 C--    o GAD_ADVSCHEME_INIT
                0006 C--    o GAD_ADVSCHEME_SET
                0007 C--    o GAD_ADVSCHEME_GET (Function)
                0008
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP
                0011 C     !ROUTINE: GAD_ADVSCHEME_INIT
                0012
                0013 C     !INTERFACE:
                0014       SUBROUTINE GAD_ADVSCHEME_INIT( myThid )
                0015
                0016 C     !DESCRIPTION:
                0017 C     *==========================================================*
                0018 C     | S/R GAD\_ADVSCHEME\_INIT
                0019 C     | o Initialise shared local variables
                0020 C     *==========================================================*
                0021
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 C--   Global variables
                0025 #include "SIZE.h"
                0026 #include "GAD.h"
                0027
                0028 C--   Local variables shared by S/R within this file (gad_advscheme.F)
                0029 C     GAD_advScheme_OlMin :: overlap minimum size for this advection scheme
                0030       INTEGER GAD_advScheme_OlMin(GAD_Scheme_MaxNum)
                0031       COMMON /GAD_ADVSCHEME_LOCAL/ GAD_advScheme_OlMin
                0032
                0033 C     !INPUT PARAMETERS:
                0034 C     myThid    :: my Thread Id number
                0035       INTEGER myThid
                0036
                0037 C     !LOCAL VARIABLES:
                0038       INTEGER n
                0039 CEOP
                0040
                0041       _BEGIN_MASTER(myThid)
                0042        DO n=1,GAD_Scheme_MaxNum
                0043          GAD_advScheme_OlMin(n) = -1
                0044        ENDDO
                0045       _END_MASTER(myThid)
                0046
                0047       RETURN
                0048       END
                0049
                0050 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0051 CBOP
                0052 C     !ROUTINE: GAD_ADVSCHEME_SET
                0053
                0054 C     !INTERFACE:
                0055       SUBROUTINE GAD_ADVSCHEME_SET(
                0056      I                         advScheme, OlMinSize,
                0057      U                         errCode,
                0058      I                         myThid )
                0059
                0060 C     !DESCRIPTION:
                0061 C     *==========================================================*
                0062 C     | S/R GAD\_ADVSCHEME\_SET
                0063 C     | o Store minimum length of OverLap (related to stencil)
                0064 C     |   that this advection needs.
                0065 C     *==========================================================*
                0066
                0067 C     !USES:
                0068       IMPLICIT NONE
                0069 C--   Global variables
                0070 #include "SIZE.h"
                0071 #include "EEPARAMS.h"
                0072 #include "GAD.h"
                0073
                0074 C--   Local variables shared by S/R within this file (gad_advscheme.F)
                0075 C     GAD_advScheme_OlMin :: overlap minimum size for this advection scheme
                0076       INTEGER GAD_advScheme_OlMin(GAD_Scheme_MaxNum)
                0077       COMMON /GAD_ADVSCHEME_LOCAL/ GAD_advScheme_OlMin
                0078
                0079 C     !INPUT/OUTPUT PARAMETERS:
                0080 C     advScheme :: advection scheme number
                0081 C     OlMinSize :: overlap minimum size for this advection scheme
                0082 C     errCode   :: tracks occurence of errors ( > 0)
                0083 C     myThid    :: my Thread Id number
                0084       INTEGER advScheme
                0085       INTEGER OlMinSize
                0086       INTEGER errCode
                0087       INTEGER myThid
                0088
                0089 C     !LOCAL VARIABLES:
                0090 C     msgBuf  :: Informational/error message buffer
                0091       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0092 CEOP
                0093
                0094       IF ( advScheme.GE.1 .AND. advScheme.LE.GAD_Scheme_MaxNum ) THEN
                0095        _BEGIN_MASTER(myThid)
                0096         GAD_advScheme_OlMin(advScheme) = OlMinSize
                0097        _END_MASTER(myThid)
                0098       ELSE
                0099         WRITE(msgBuf,'(2A,I6,A)') 'GAD_ADVSCHEME_SET: ',
                0100      &    'Advection-Scheme Number:', advScheme, ' not valid'
                0101         CALL PRINT_ERROR( msgBuf, myThid )
                0102         WRITE(msgBuf,'(2A,I4,A)') 'GAD_ADVSCHEME_SET: ',
                0103      &    'should be > 0 and < GAD_Scheme_MaxNum =', GAD_Scheme_MaxNum
                0104         CALL PRINT_ERROR( msgBuf, myThid )
                0105         errCode = MAX( errCode, 1 )
                0106       ENDIF
                0107
                0108       RETURN
                0109       END
                0110
                0111 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0112 CBOP
                0113 C     !ROUTINE: GAD_ADVSCHEME_GET
                0114
                0115 C     !INTERFACE:
                0116       INTEGER FUNCTION GAD_ADVSCHEME_GET( advScheme )
                0117
                0118 C     !DESCRIPTION:
                0119 C     *==========================================================*
                0120 C     | INTEGER FUNCTION GAD\_ADVSCHEME\_GET
                0121 C     | o Return minimum length of OverLap (related to stencil)
                0122 C     |   that this advection needs.
                0123 C     *==========================================================*
                0124
                0125 C     !USES:
                0126       IMPLICIT NONE
                0127 C--   Global variables
                0128 #include "SIZE.h"
                0129 #include "GAD.h"
                0130
                0131 C--   Local variables shared by S/R within this file (gad_advscheme.F)
                0132 C     GAD_advScheme_OlMin :: overlap minimum size for this advection scheme
                0133       INTEGER GAD_advScheme_OlMin(GAD_Scheme_MaxNum)
                0134       COMMON /GAD_ADVSCHEME_LOCAL/ GAD_advScheme_OlMin
                0135
                0136 C     !INPUT PARAMETERS:
                0137 C     advScheme  :: advection scheme number
                0138       INTEGER advScheme
                0139
                0140 C     !LOCAL VARIABLES:
                0141 CEOP
                0142
                0143       IF ( advScheme.GE.1 .AND. advScheme.LE.GAD_Scheme_MaxNum ) THEN
                0144         GAD_ADVSCHEME_GET = GAD_advScheme_OlMin(advScheme)
                0145       ELSE
                0146         GAD_ADVSCHEME_GET = -2
                0147       ENDIF
                0148
                0149       RETURN
                0150       END