pkg/generic_advdiff/gad_init_fixed.F

c17bf9e7ce Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 CBOP
e663d180db Jean*0004 C     !ROUTINE: GAD_INIT_FIXED
c17bf9e7ce Jean*0005 C     !INTERFACE:
e663d180db Jean*0006       SUBROUTINE GAD_INIT_FIXED( myThid )
1b5fb69d21 Ed H*0007 C     !DESCRIPTION:
                0008 C     Routine to initialize Generic Advection/Diffusion variables and
                0009 C     constants.
c17bf9e7ce Jean*0010
                0011 C     !USES:
                0012       IMPLICIT NONE
                0013 C     === Global variables ===
                0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #include "GAD.h"
                0018
                0019 C     !INPUT/OUTPUT PARAMETERS:
                0020 C     === Routine arguments ===
65d3db6a48 Jean*0021 C     myThid  :: My Thread Id. number
c17bf9e7ce Jean*0022       INTEGER myThid
                0023 CEOP
                0024
26e9727e55 Jean*0025 C     !FUNCTIONS
a9f828d17c Jean*0026       INTEGER  GAD_ADVSCHEME_GET
                0027       EXTERNAL GAD_ADVSCHEME_GET
26e9727e55 Jean*0028
                0029 C     !LOCAL VARIABLES:
c17bf9e7ce Jean*0030 C     === Local variables ===
26e9727e55 Jean*0031 C     msgBuf  :: Informational/error message buffer
c17bf9e7ce Jean*0032       CHARACTER*(MAX_LEN_MBUF) msgBuf
a9f828d17c Jean*0033       INTEGER   errCode, n, minSize
c17bf9e7ce Jean*0034
                0035 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0036
9b8b001637 Jean*0037       _BEGIN_MASTER(myThid)
                0038
26e9727e55 Jean*0039 C-- Initialise advection scheme parameter
a9f828d17c Jean*0040       CALL GAD_ADVSCHEME_INIT( myThid )
                0041
                0042 C-  Set advection scheme parameter (overlap minimum size) for each scheme:
                0043       errCode = 0
                0044       CALL GAD_ADVSCHEME_SET( ENUM_UPWIND_1RST   , 1, errCode, myThid )
                0045       CALL GAD_ADVSCHEME_SET( ENUM_CENTERED_2ND  , 1, errCode, myThid )
                0046       CALL GAD_ADVSCHEME_SET( ENUM_UPWIND_3RD    , 2, errCode, myThid )
                0047       CALL GAD_ADVSCHEME_SET( ENUM_CENTERED_4TH  , 2, errCode, myThid )
                0048       CALL GAD_ADVSCHEME_SET( ENUM_DST2          , 1, errCode, myThid )
                0049       CALL GAD_ADVSCHEME_SET( ENUM_FLUX_LIMIT    , 2, errCode, myThid )
                0050       CALL GAD_ADVSCHEME_SET( ENUM_DST3          , 2, errCode, myThid )
                0051       CALL GAD_ADVSCHEME_SET( ENUM_DST3_FLUX_LIMIT,2, errCode, myThid )
                0052       CALL GAD_ADVSCHEME_SET( ENUM_OS7MP         , 4, errCode, myThid )
                0053       CALL GAD_ADVSCHEME_SET( ENUM_SOM_PRATHER   , 1, errCode, myThid )
                0054       CALL GAD_ADVSCHEME_SET( ENUM_SOM_LIMITER   , 1, errCode, myThid )
8e4c181d69 Jean*0055       CALL GAD_ADVSCHEME_SET( ENUM_PPM_NULL_LIMIT, 3, errCode, myThid )
                0056       CALL GAD_ADVSCHEME_SET( ENUM_PPM_MONO_LIMIT, 3, errCode, myThid )
                0057       CALL GAD_ADVSCHEME_SET( ENUM_PPM_WENO_LIMIT, 3, errCode, myThid )
                0058       CALL GAD_ADVSCHEME_SET( ENUM_PQM_NULL_LIMIT, 4, errCode, myThid )
                0059       CALL GAD_ADVSCHEME_SET( ENUM_PQM_MONO_LIMIT, 4, errCode, myThid )
                0060       CALL GAD_ADVSCHEME_SET( ENUM_PQM_WENO_LIMIT, 4, errCode, myThid )
a9f828d17c Jean*0061       IF ( errCode.GT.0 ) THEN
26e9727e55 Jean*0062         WRITE(msgBuf,'(A)')
a9f828d17c Jean*0063      &     'GAD_INIT_FIXED: Invalid Advection-Scheme Number setting'
26e9727e55 Jean*0064         CALL PRINT_ERROR( msgBuf, myThid )
                0065         STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
                0066       ENDIF
a9f828d17c Jean*0067
26e9727e55 Jean*0068 C-  Initialise overlap minimum size for GAD pkg:
                0069       GAD_OlMinSize(1) = 0
                0070       GAD_OlMinSize(2) = 0
                0071       GAD_OlMinSize(3) = 1
                0072
                0073 C-  Set SOM I/O suffix (used for pickup, diagnostics ...)
65d3db6a48 Jean*0074       DO n=1,nSOM
                0075         somSfx(n) = '  '
                0076         IF (n.EQ.1) somSfx(n) = '_x'
                0077         IF (n.EQ.2) somSfx(n) = '_y'
                0078         IF (n.EQ.3) somSfx(n) = '_z'
                0079         IF (n.EQ.4) somSfx(n) = 'xx'
                0080         IF (n.EQ.5) somSfx(n) = 'yy'
                0081         IF (n.EQ.6) somSfx(n) = 'zz'
                0082         IF (n.EQ.7) somSfx(n) = 'xy'
                0083         IF (n.EQ.8) somSfx(n) = 'xz'
                0084         IF (n.EQ.9) somSfx(n) = 'yz'
                0085       ENDDO
                0086
26e9727e55 Jean*0087 C-- Check that Temp & Salt have valid advection scheme number:
a9f828d17c Jean*0088       n = GAD_ADVSCHEME_GET( tempAdvScheme )
                0089       IF ( n.LT.0 ) THEN
6433d105a5 Jean*0090         WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED: ',
                0091      &   'invalid Temp. advection scheme number=', tempAdvScheme
26e9727e55 Jean*0092         CALL PRINT_ERROR( msgBuf, myThid )
                0093         STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
                0094       ENDIF
a9f828d17c Jean*0095       n = GAD_ADVSCHEME_GET( tempVertAdvScheme )
                0096       IF ( n.LT.0 ) THEN
6433d105a5 Jean*0097         WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED: ',
                0098      &   'invalid Temp. Vert. Adv.scheme number=', tempVertAdvScheme
26e9727e55 Jean*0099         CALL PRINT_ERROR( msgBuf, myThid )
                0100         STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
                0101       ENDIF
a9f828d17c Jean*0102       n = GAD_ADVSCHEME_GET( saltAdvScheme )
                0103       IF ( n.LT.0 ) THEN
6433d105a5 Jean*0104         WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED: ',
                0105      &   'invalid Salt. advection scheme number=', saltAdvScheme
26e9727e55 Jean*0106         CALL PRINT_ERROR( msgBuf, myThid )
                0107         STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
                0108       ENDIF
a9f828d17c Jean*0109       n = GAD_ADVSCHEME_GET( saltVertAdvScheme )
                0110       IF ( n.LT.0 ) THEN
6433d105a5 Jean*0111         WRITE(msgBuf,'(2A,I6)') 'GAD_INIT_FIXED: ',
                0112      &   'invalid Salt. Vert. Adv.scheme number=', saltVertAdvScheme
26e9727e55 Jean*0113         CALL PRINT_ERROR( msgBuf, myThid )
                0114         STOP 'ABNORMAL END: S/R GAD_INIT_FIXED'
                0115       ENDIF
                0116
d7ce0d34f8 Jean*0117 C-- Set Temp & Salt 2nd-Order Moment Advec. flag according to advection scheme
                0118       tempSOM_Advection = tempAdvScheme.GE.ENUM_SOM_PRATHER
                0119      &              .AND. tempAdvScheme.LE.ENUM_SOM_LIMITER
                0120       tempSOM_Advection = tempSOM_Advection .AND. tempAdvection
                0121       saltSOM_Advection = saltAdvScheme.GE.ENUM_SOM_PRATHER
                0122      &              .AND. saltAdvScheme.LE.ENUM_SOM_LIMITER
                0123       saltSOM_Advection = saltSOM_Advection .AND. saltAdvection
                0124
1edeb03c55 Jean*0125 C-- Set Temp & Salt multi-Dim Advec. flag according to advection scheme used
ee8b46da18 Jean*0126       tempMultiDimAdvec = multiDimAdvection .AND. tempAdvection
                0127       saltMultiDimAdvec = multiDimAdvection .AND. saltAdvection
c17bf9e7ce Jean*0128       IF ( tempAdvScheme.EQ.ENUM_CENTERED_2ND
                0129      & .OR.tempAdvScheme.EQ.ENUM_UPWIND_3RD
                0130      & .OR.tempAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
1bb133c00c Jean*0131            tempMultiDimAdvec = .FALSE.
c17bf9e7ce Jean*0132       ENDIF
                0133       IF ( saltAdvScheme.EQ.ENUM_CENTERED_2ND
                0134      & .OR.saltAdvScheme.EQ.ENUM_UPWIND_3RD
                0135      & .OR.saltAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
1bb133c00c Jean*0136            saltMultiDimAdvec = .FALSE.
c17bf9e7ce Jean*0137       ENDIF
                0138
1edeb03c55 Jean*0139 C-- Set general multi-Dim Advec. flag when at least 1 tracer use multi-Dim Advec.
                0140       useMultiDimAdvec = useMultiDimAdvec.OR.tempMultiDimAdvec
                0141       useMultiDimAdvec = useMultiDimAdvec.OR.saltMultiDimAdvec
                0142
c17bf9e7ce Jean*0143 C-- Set Temp & Salt Adams-Bashforth flag according to advection scheme used
1bb133c00c Jean*0144       AdamsBashforthGt = .FALSE.
                0145       AdamsBashforthGs = .FALSE.
                0146       AdamsBashforth_T = .FALSE.
                0147       AdamsBashforth_S = .FALSE.
c17bf9e7ce Jean*0148       IF ( tempAdvScheme.EQ.ENUM_CENTERED_2ND
                0149      & .OR.tempAdvScheme.EQ.ENUM_UPWIND_3RD
                0150      & .OR.tempAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
1bb133c00c Jean*0151            AdamsBashforthGt = tempStepping
c17bf9e7ce Jean*0152       ENDIF
                0153       IF ( saltAdvScheme.EQ.ENUM_CENTERED_2ND
                0154      & .OR.saltAdvScheme.EQ.ENUM_UPWIND_3RD
                0155      & .OR.saltAdvScheme.EQ.ENUM_CENTERED_4TH ) THEN
1bb133c00c Jean*0156            AdamsBashforthGs = saltStepping
c17bf9e7ce Jean*0157       ENDIF
6433d105a5 Jean*0158       IF ( .NOT.doAB_onGtGs ) THEN
1bb133c00c Jean*0159         AdamsBashforth_T = AdamsBashforthGt
                0160         AdamsBashforth_S = AdamsBashforthGs
                0161         AdamsBashforthGt = .FALSE.
                0162         AdamsBashforthGs = .FALSE.
                0163       ENDIF
                0164
998cbd211e Oliv*0165 #ifdef GAD_SMOLARKIEWICZ_HACK
                0166       SmolarkiewiczMaxFrac = 1. _d 0
                0167 #endif
                0168
26e9727e55 Jean*0169 C-- Set Overlap minimum size according to Temp & Salt advection
                0170       IF ( tempAdvection ) THEN
a9f828d17c Jean*0171          minSize = GAD_ADVSCHEME_GET( tempAdvScheme )
                0172          GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1), minSize )
26e9727e55 Jean*0173       ENDIF
                0174       IF ( saltAdvection ) THEN
a9f828d17c Jean*0175          minSize = GAD_ADVSCHEME_GET( saltAdvScheme )
                0176          GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1), minSize )
26e9727e55 Jean*0177       ENDIF
                0178       IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
6433d105a5 Jean*0179 C-    multi-dim-advection on CS-grid requires to double the size of OLx,OLy
26e9727e55 Jean*0180         GAD_OlMinSize(3) = MAX( GAD_OlMinSize(3), 2 )
                0181       ENDIF
                0182       WRITE(msgBuf,'(A,9I3)')
                0183      &      'GAD_INIT_FIXED: GAD_OlMinSize=', GAD_OlMinSize
                0184       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0185
9b8b001637 Jean*0186       _END_MASTER(myThid)
                0187
c17bf9e7ce Jean*0188 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0189
81c8d7b9aa Jean*0190 #ifdef ALLOW_DIAGNOSTICS
                0191       IF ( useDiagnostics ) THEN
                0192 C--   Add diagnostics of Temp & Salt fluxes to the (long) list of diagnostics:
                0193         CALL GAD_DIAGNOSTICS_INIT( myThid )
                0194       ENDIF
                0195 #endif /* ALLOW_DIAGNOSTICS */
                0196
                0197 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0198
c17bf9e7ce Jean*0199 C-- Print out GAD parameters :
                0200       _BEGIN_MASTER(myThid)
                0201
                0202       WRITE(msgBuf,'(A)') ' '
                0203       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0204       WRITE(msgBuf,'(A)') '// ==================================='
                0205       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0206       WRITE(msgBuf,'(A)')'// GAD parameters :'
                0207       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0208       WRITE(msgBuf,'(A)') '// ==================================='
                0209       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0210
                0211       CALL WRITE_0D_I( tempAdvScheme, INDEX_NONE,
                0212      & 'tempAdvScheme =',
1bb133c00c Jean*0213      & '   /* Temp. Horiz.Advection scheme selector */')
49efc6c1e0 Jean*0214       CALL WRITE_0D_I( tempVertAdvScheme, INDEX_NONE,
                0215      & 'tempVertAdvScheme =',
1bb133c00c Jean*0216      & '   /* Temp. Vert. Advection scheme selector */')
c17bf9e7ce Jean*0217       CALL WRITE_0D_L( tempMultiDimAdvec, INDEX_NONE,
                0218      & 'tempMultiDimAdvec =',
                0219      & '   /* use Muti-Dim Advec method for Temp */')
d7ce0d34f8 Jean*0220       CALL WRITE_0D_L( tempSOM_Advection, INDEX_NONE,
                0221      & 'tempSOM_Advection =',
                0222      & ' /* use 2nd Order Moment Advection for Temp */')
1bb133c00c Jean*0223       CALL WRITE_0D_L( AdamsBashforthGt, INDEX_NONE,
                0224      & 'AdamsBashforthGt =',
d7ce0d34f8 Jean*0225      & ' /* apply Adams-Bashforth extrapolation on Gt */')
1bb133c00c Jean*0226       CALL WRITE_0D_L( AdamsBashforth_T, INDEX_NONE,
                0227      & 'AdamsBashforth_T =',
d7ce0d34f8 Jean*0228      & ' /* apply Adams-Bashforth extrapolation on Temp */')
46918f1b26 Jean*0229 #ifdef GAD_SMOLARKIEWICZ_HACK
                0230       CALL WRITE_0D_L( temp_stayPositive, INDEX_NONE,
                0231      & 'temp_stayPositive =',
                0232      & ' /* use Smolarkiewicz Hack for Temperature */')
                0233 #endif
c17bf9e7ce Jean*0234
                0235       CALL WRITE_0D_I( saltAdvScheme, INDEX_NONE,
                0236      & 'saltAdvScheme =',
1bb133c00c Jean*0237      & '   /* Salt. Horiz.advection scheme selector */')
49efc6c1e0 Jean*0238       CALL WRITE_0D_I( saltVertAdvScheme, INDEX_NONE,
                0239      & 'saltVertAdvScheme =',
1bb133c00c Jean*0240      & '   /* Salt. Vert. Advection scheme selector */')
c17bf9e7ce Jean*0241       CALL WRITE_0D_L( saltMultiDimAdvec, INDEX_NONE,
                0242      & 'saltMultiDimAdvec =',
                0243      & '   /* use Muti-Dim Advec method for Salt */')
d7ce0d34f8 Jean*0244       CALL WRITE_0D_L( saltSOM_Advection, INDEX_NONE,
                0245      & 'saltSOM_Advection =',
                0246      & ' /* use 2nd Order Moment Advection for Salt */')
1bb133c00c Jean*0247       CALL WRITE_0D_L( AdamsBashforthGs, INDEX_NONE,
                0248      & 'AdamsBashforthGs =',
d7ce0d34f8 Jean*0249      & ' /* apply Adams-Bashforth extrapolation on Gs */')
1bb133c00c Jean*0250       CALL WRITE_0D_L( AdamsBashforth_S, INDEX_NONE,
                0251      & 'AdamsBashforth_S =',
d7ce0d34f8 Jean*0252      & ' /* apply Adams-Bashforth extrapolation on Salt */')
998cbd211e Oliv*0253 #ifdef GAD_SMOLARKIEWICZ_HACK
46918f1b26 Jean*0254       CALL WRITE_0D_L( salt_stayPositive, INDEX_NONE,
                0255      & 'salt_stayPositive =',
                0256      & ' /* use Smolarkiewicz Hack for Salinity */')
                0257 #endif
                0258
                0259 #ifdef GAD_SMOLARKIEWICZ_HACK
4da4b49499 Jean*0260       CALL WRITE_0D_RL( SmolarkiewiczMaxFrac, INDEX_NONE,
998cbd211e Oliv*0261      & 'SmolarkiewiczMaxFrac =',
                0262      & ' /* maximal fraction of tracer to flow out of a cell */')
                0263 #endif
c17bf9e7ce Jean*0264       WRITE(msgBuf,'(A)') '// ==================================='
                0265       CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
                0266
965ef81639 Jean*0267 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0268
c17bf9e7ce Jean*0269       _END_MASTER(myThid)
                0270       _BARRIER
                0271
                0272       RETURN
                0273       END