model/src/set_parms.F

4e66ab0b67 Oliv*0001 #include "PACKAGES_CONFIG.h"
809bdccbfc Jean*0002 #include "CPP_OPTIONS.h"
0301aae365 Jean*0003 #ifdef ALLOW_MOM_COMMON
                0004 # include "MOM_COMMON_OPTIONS.h"
                0005 #endif
809bdccbfc Jean*0006
                0007 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0008 CBOP
                0009 C     !ROUTINE: SET_PARMS
                0010 C     !INTERFACE:
                0011       SUBROUTINE SET_PARMS( myThid )
                0012
                0013 C     !DESCRIPTION:
                0014 C     Set model "parameters" that might depend on the use of some pkgs;
                0015 C     called from INITIALISE_FIXED, after INI_PARMS & PACKAGES_READPARAMS
                0016 C     NOTES: After leaving this S/R, parameters will not change anymore.
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
c7ad17745a Jean*0023 #include "EOS.h"
0301aae365 Jean*0024 #ifdef ALLOW_MOM_COMMON
                0025 # include "MOM_VISC.h"
                0026 #endif
809bdccbfc Jean*0027
                0028 C     !INPUT/OUTPUT PARAMETERS:
3fcd8a21e5 Jean*0029 C     myThid :: My Thread Id number
809bdccbfc Jean*0030       INTEGER myThid
                0031
1cfd78e5a7 Jean*0032 C     !FUNCTIONS:
809bdccbfc Jean*0033 c     INTEGER  ILNBLNK
                0034 c     EXTERNAL ILNBLNK
1cfd78e5a7 Jean*0035
                0036 C     !LOCAL VARIABLES:
                0037       CHARACTER*(MAX_LEN_MBUF) msgBuf
aa6b2555c8 Jean*0038       INTEGER errCount, k
1cfd78e5a7 Jean*0039       _RL tmpVar
809bdccbfc Jean*0040 CEOP
                0041
ac2fc522e8 Jean*0042 C--   Set (or reset) On/Off flags :
809bdccbfc Jean*0043
ac2fc522e8 Jean*0044 C-    For off-line calculation, switch off Momentum and Active-tracers (=T,S):
                0045 #ifdef ALLOW_OFFLINE
809bdccbfc Jean*0046       IF ( useOffLine ) THEN
ac2fc522e8 Jean*0047         CALL OFFLINE_RESET_PARMS( myThid )
809bdccbfc Jean*0048       ENDIF
ac2fc522e8 Jean*0049 #endif /* ALLOW_OFFLINE */
809bdccbfc Jean*0050
ac2fc522e8 Jean*0051       _BEGIN_MASTER(myThid)
aa6b2555c8 Jean*0052       errCount = 0
809bdccbfc Jean*0053
427e24e121 Jean*0054 C--   Make metric term & Coriolis settings consistent with underlying grid.
                0055       IF ( usingCartesianGrid ) THEN
                0056         selectMetricTerms = 0
                0057         useNHMTerms   = .FALSE.
                0058       ENDIF
                0059       IF ( usingCylindricalGrid ) THEN
                0060         useNHMTerms   = .FALSE.
                0061         WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; Cylinder OK'
                0062         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0063      &                     SQUEEZE_RIGHT, myThid )
                0064       ENDIF
                0065       IF ( usingCurvilinearGrid ) THEN
                0066         selectMetricTerms = 0
                0067       ENDIF
                0068       IF ( selectCoriMap.EQ.-1 ) THEN
                0069         IF ( usingCartesianGrid.OR.usingCylindricalGrid ) THEN
                0070 C       default is to use Beta-Plane Coriolis
                0071           selectCoriMap = 1
                0072         ELSE
                0073 C       default for other grids is to use Spherical Coriolis
                0074           selectCoriMap = 2
                0075         ENDIF
                0076       ENDIF
                0077       IF ( .NOT.(nonHydrostatic.OR.quasiHydrostatic) )
                0078      &                          select3dCoriScheme = 0
                0079       IF ( (selectCoriMap.EQ.0 .OR.selectCoriMap.EQ.1)
                0080      &     .AND. fPrime.EQ.0. ) select3dCoriScheme = 0
                0081
809bdccbfc Jean*0082 C--   On/Off flags for each terms of the momentum equation
                0083       nonHydrostatic   = momStepping .AND. nonHydrostatic
                0084       quasiHydrostatic = momStepping .AND. quasiHydrostatic
59b35dd864 Jean*0085       momAdvection     = momStepping .AND. momAdvection
                0086       momViscosity     = momStepping .AND. momViscosity
                0087       momForcing       = momStepping .AND. momForcing
                0088       momTidalForcing  = momForcing  .AND. momTidalForcing
                0089       useCoriolis      = momStepping .AND. useCoriolis
427e24e121 Jean*0090       IF ( .NOT.useCoriolis ) select3dCoriScheme = 0
59b35dd864 Jean*0091       useCDscheme      = momStepping .AND. useCDscheme
809bdccbfc Jean*0092       momPressureForcing= momStepping .AND. momPressureForcing
                0093       implicitIntGravWave=momPressureForcing .AND. implicitIntGravWave
                0094       momImplVertAdv   = momAdvection .AND. momImplVertAdv
                0095       implicitViscosity= momViscosity .AND. implicitViscosity
dc3adfb09b Jean*0096       useSmag3D        = momViscosity .AND. useSmag3D
809bdccbfc Jean*0097       use3Dsolver      = nonHydrostatic.OR. implicitIntGravWave
4947dcf697 Jean*0098       calc_wVelocity   = momStepping .OR. exactConserv
3fcd8a21e5 Jean*0099
0301aae365 Jean*0100 #ifndef ALLOW_3D_VISCAH
aa6b2555c8 Jean*0101       IF ( viscAhDfile.NE.' ' .OR. viscAhZfile.NE.' ' ) THEN
1a6ecc2dd5 Jean*0102         WRITE(msgBuf,'(2A)') 'SET_PARMS: ',
0301aae365 Jean*0103      &      'viscAhDfile and viscAhZfile cannot be used with'
                0104         CALL PRINT_ERROR( msgBuf, myThid )
1a6ecc2dd5 Jean*0105         WRITE(msgBuf,'(2A)') 'SET_PARMS: ',
0301aae365 Jean*0106      &      '"#undef ALLOW_3D_VISCAH" in MOM_COMMON_OPTIONS.h'
                0107         CALL PRINT_ERROR( msgBuf, myThid )
aa6b2555c8 Jean*0108         errCount = errCount + 1
                0109       ENDIF
0301aae365 Jean*0110 #endif
                0111 #ifndef ALLOW_3D_VISCA4
aa6b2555c8 Jean*0112       IF ( viscA4Dfile.NE.' ' .OR. viscA4Zfile.NE.' ' ) THEN
1a6ecc2dd5 Jean*0113         WRITE(msgBuf,'(2A)') 'SET_PARMS: ',
0301aae365 Jean*0114      &      'viscA4Dfile and viscA4Zfile cannot be used with'
                0115         CALL PRINT_ERROR( msgBuf, myThid )
1a6ecc2dd5 Jean*0116         WRITE(msgBuf,'(2A)') 'SET_PARMS: ',
0301aae365 Jean*0117      &      '"#undef ALLOW_3D_VISCA4" in MOM_COMMON_OPTIONS.h'
                0118         CALL PRINT_ERROR( msgBuf, myThid )
aa6b2555c8 Jean*0119         errCount = errCount + 1
                0120       ENDIF
0301aae365 Jean*0121 #endif
                0122
                0123 #ifdef ALLOW_MOM_COMMON
                0124 C-    On/Off flags for viscosity coefficients
                0125       useVariableVisc   =
                0126      &      viscAhGrid  .NE.zeroRL .OR. viscA4Grid  .NE.zeroRL
                0127      &  .OR. viscC2smag .NE.zeroRL .OR. viscC4smag  .NE.zeroRL
                0128      &  .OR. viscC2leith.NE.zeroRL .OR. viscC2leithD.NE.zeroRL
f59d76b0dd Ed D*0129      &  .OR. viscC2LeithQG.NE.zeroRL
0301aae365 Jean*0130      &  .OR. viscC4leith.NE.zeroRL .OR. viscC4leithD.NE.zeroRL
                0131      &  .OR. viscAhDfile.NE.' '    .OR.  viscAhZfile.NE.' '
                0132      &  .OR. viscA4Dfile.NE.' '    .OR.  viscA4Zfile.NE.' '
                0133
                0134       useHarmonicVisc   = viscAh .NE.zeroRL
                0135      &  .OR. viscAhD    .NE.zeroRL .OR. viscAhZ     .NE.zeroRL
                0136      &  .OR. viscAhGrid .NE.zeroRL .OR. viscC2smag  .NE.zeroRL
                0137      &  .OR. viscC2leith.NE.zeroRL .OR. viscC2leithD.NE.zeroRL
f59d76b0dd Ed D*0138      &  .OR. viscC2LeithQG.NE.zeroRL
0301aae365 Jean*0139      &  .OR. viscAhDfile.NE. ' '   .OR. viscAhZfile .NE. ' '
                0140
                0141       useBiharmonicVisc = viscA4.NE.zeroRL
                0142      &  .OR. viscA4D    .NE.zeroRL .OR. viscA4Z     .NE.zeroRL
                0143      &  .OR. viscA4Grid .NE.zeroRL .OR. viscC4smag  .NE.zeroRL
                0144      &  .OR. viscC4leith.NE.zeroRL .OR. viscC4leithD.NE.zeroRL
                0145      &  .OR. viscA4Dfile.NE. ' '   .OR. viscA4Zfile .NE. ' '
                0146
                0147       useVariableVisc   = momViscosity .AND. useVariableVisc
                0148       useHarmonicVisc   = momViscosity .AND. useHarmonicVisc
                0149       useBiharmonicVisc = momViscosity .AND. useBiharmonicVisc
                0150 #endif /* ALLOW_MOM_COMMON */
ab47de63dc Mart*0151       IF ( ( bottomDragQuadratic.EQ.0. .AND. zRoughBot.EQ.0. )
                0152      &     .OR. .NOT.momViscosity ) selectBotDragQuadr = -1
0301aae365 Jean*0153
3fcd8a21e5 Jean*0154 C--   Free-surface & pressure method
2ee74bea59 Jean*0155       uniformFreeSurfLev = usingZCoords
283763fbbb Jean*0156 C- Note: comment line below to revert to full-cell hydrostatic-pressure
                0157 C        calculation in surface grid-cell below ice-shelf
                0158       uniformFreeSurfLev = usingZCoords .AND. .NOT.useShelfIce
8233d0ceb9 Jean*0159      &                                  .AND. topoFile.EQ.' '
3fcd8a21e5 Jean*0160       IF ( selectNHfreeSurf.NE.0 .AND.
                0161      &      ( .NOT.nonHydrostatic .OR. usingPCoords
                0162      &        .OR. .NOT.exactConserv
                0163      &      ) ) THEN
                0164         WRITE(msgBuf,'(2A)') '** WARNING ** SET_PARMS: ',
                0165      &                       'reset selectNHfreeSurf to zero'
                0166         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0167      &                      SQUEEZE_RIGHT, myThid )
                0168         selectNHfreeSurf = 0
                0169       ENDIF
02d90fb24c Jean*0170 #ifdef ALLOW_AUTODIFF
627a21a418 Jean*0171       doResetHFactors = .TRUE.
                0172 #endif
                0173 #ifndef NONLIN_FRSURF
                0174       doResetHFactors = .FALSE.
                0175 #endif
aa3dd96e14 Jean*0176
7fe6343684 Jean*0177 C--   Set default Vorticity-Term Scheme:
                0178       IF ( vectorInvariantMomentum ) THEN
                0179         IF ( selectVortScheme.EQ.UNSET_I ) THEN
                0180           selectVortScheme = 1
                0181           IF ( upwindVorticity )    selectVortScheme = 0
                0182           IF ( highOrderVorticity ) selectVortScheme = 0
                0183         ENDIF
                0184       ELSEIF ( selectVortScheme.NE.UNSET_I ) THEN
                0185         WRITE(msgBuf,'(A,A)') '** WARNING ** SET_PARMS: ',
                0186      &   'Vector-Invariant Momentum unused => ignore selectVortScheme'
3fcd8a21e5 Jean*0187         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0188      &                      SQUEEZE_RIGHT, myThid )
7fe6343684 Jean*0189       ENDIF
9293d3c672 Hajo*0190       useAbsVorticity = vectorInvariantMomentum .AND. useAbsVorticity
809bdccbfc Jean*0191 C--   Momentum viscosity on/off flag.
                0192       IF ( momViscosity        ) THEN
3fcd8a21e5 Jean*0193        vfFacMom = 1. _d 0
809bdccbfc Jean*0194       ELSE
3fcd8a21e5 Jean*0195        vfFacMom = 0. _d 0
809bdccbfc Jean*0196       ENDIF
                0197 C--   Momentum advection on/off flag.
                0198       IF ( momAdvection        ) THEN
3fcd8a21e5 Jean*0199        afFacMom = 1. _d 0
809bdccbfc Jean*0200       ELSE
3fcd8a21e5 Jean*0201        afFacMom = 0. _d 0
809bdccbfc Jean*0202       ENDIF
                0203 C--   Momentum forcing on/off flag.
                0204       IF ( momForcing ) THEN
3fcd8a21e5 Jean*0205        foFacMom = 1. _d 0
809bdccbfc Jean*0206       ELSE
3fcd8a21e5 Jean*0207        foFacMom = 0. _d 0
809bdccbfc Jean*0208       ENDIF
                0209 C--   Coriolis term on/off flag.
                0210       IF ( useCoriolis ) THEN
3fcd8a21e5 Jean*0211        cfFacMom = 1. _d 0
809bdccbfc Jean*0212       ELSE
3fcd8a21e5 Jean*0213        cfFacMom = 0. _d 0
809bdccbfc Jean*0214       ENDIF
                0215 C--   Pressure term on/off flag.
                0216       IF ( momPressureForcing ) THEN
3fcd8a21e5 Jean*0217        pfFacMom = 1. _d 0
809bdccbfc Jean*0218       ELSE
3fcd8a21e5 Jean*0219        pfFacMom = 0. _d 0
809bdccbfc Jean*0220       ENDIF
                0221 C--   Metric terms on/off flag.
427e24e121 Jean*0222       IF ( selectMetricTerms.GE.1 ) THEN
3fcd8a21e5 Jean*0223        mTFacMom = 1. _d 0
809bdccbfc Jean*0224       ELSE
3fcd8a21e5 Jean*0225        mTFacMom = 0. _d 0
809bdccbfc Jean*0226       ENDIF
                0227
                0228 C--   Advection and Forcing for Temp and salt  on/off flags
bf6138bedc Jean*0229       tempVertDiff4 = .FALSE.
                0230       saltVertDiff4 = .FALSE.
                0231       DO k=1,Nr
                0232         tempVertDiff4 = tempVertDiff4 .OR. ( diffKr4T(k).GT.0. _d 0 )
                0233         saltVertDiff4 = saltVertDiff4 .OR. ( diffKr4S(k).GT.0. _d 0 )
                0234       ENDDO
809bdccbfc Jean*0235       tempAdvection = tempStepping .AND. tempAdvection
bf6138bedc Jean*0236       tempVertDiff4 = tempStepping .AND. tempVertDiff4
809bdccbfc Jean*0237       tempForcing   = tempStepping .AND. tempForcing
                0238       saltAdvection = saltStepping .AND. saltAdvection
bf6138bedc Jean*0239       saltVertDiff4 = saltStepping .AND. saltVertDiff4
809bdccbfc Jean*0240       saltForcing   = saltStepping .AND. saltForcing
                0241       tempImplVertAdv = tempAdvection .AND. tempImplVertAdv
                0242       saltImplVertAdv = saltAdvection .AND. saltImplVertAdv
7f31549cd8 Jean*0243       doThetaClimRelax = ( tempForcing .OR.( useOffLine.AND.useKPP ) )
                0244      &             .AND. ( tauThetaClimRelax.GT.0. _d 0 )
                0245       doSaltClimRelax  = ( saltForcing .OR.( useOffLine.AND.useKPP ) )
                0246      &             .AND. ( tauSaltClimRelax .GT.0. _d 0 )
809bdccbfc Jean*0247
c7ad17745a Jean*0248 C--   Dynamically Active Tracers : set flags
                0249       tempIsActiveTr = momPressureForcing .AND. tempAdvection
                0250       saltIsActiveTr = momPressureForcing .AND. saltAdvection
aa3dd96e14 Jean*0251       IF ( eosType.EQ.'IDEALG' .AND. atm_Rq.EQ.0. ) THEN
c7ad17745a Jean*0252         saltIsActiveTr = .FALSE.
                0253       ELSEIF ( eosType.EQ.'LINEAR' ) THEN
                0254         IF ( tAlpha.EQ.0. ) tempIsActiveTr = .FALSE.
                0255         IF ( sBeta .EQ.0. ) saltIsActiveTr = .FALSE.
                0256       ENDIF
                0257
427e24e121 Jean*0258 C--   Set default for latitude-band where relaxation to climatology applies
                0259 C     note: done later (once domain size is known) if using CartesianGrid
                0260       IF ( latBandClimRelax .EQ. UNSET_RL) THEN
                0261         IF ( usingSphericalPolarGrid ) latBandClimRelax= 180. _d 0
                0262         IF ( usingCurvilinearGrid )    latBandClimRelax= 180. _d 0
                0263       ENDIF
                0264
6ef71429db Jean*0265       IF ( usingZCoords ) THEN
                0266 C--   Select which pressure to use in EOS:
                0267 C     set default according to EOS type (as it was until chkpt65t)
                0268         IF ( selectP_inEOS_Zc.EQ.UNSET_I ) THEN
                0269           IF ( eosType .EQ. 'JMD95P' .OR.  eosType .EQ. 'UNESCO'
                0270      &    .OR. eosType .EQ. 'MDJWF'  .OR.  eosType .EQ. 'TEOS10'
                0271      &       ) THEN
                0272            selectP_inEOS_Zc = 2
                0273           ELSE
                0274            selectP_inEOS_Zc = 0
                0275           ENDIF
                0276         ELSEIF ( selectP_inEOS_Zc.LT.0
                0277      &      .OR. selectP_inEOS_Zc.GT.3 ) THEN
1a6ecc2dd5 Jean*0278           WRITE(msgBuf,'(A,I9,A)') 'SET_PARMS: selectP_inEOS_Zc=',
6ef71429db Jean*0279      &                  selectP_inEOS_Zc, ' : invalid selection'
                0280           CALL PRINT_ERROR( msgBuf, myThid )
aa6b2555c8 Jean*0281           errCount = errCount + 1
6ef71429db Jean*0282         ELSEIF ( .NOT.nonHydrostatic ) THEN
                0283           selectP_inEOS_Zc = MIN( selectP_inEOS_Zc, 2 )
                0284         ENDIF
                0285         IF ( ( eosType .EQ. 'LINEAR' .OR.  eosType .EQ. 'POLY3 ' )
                0286      &      .AND. selectP_inEOS_Zc.NE.0  ) THEN
1a6ecc2dd5 Jean*0287           WRITE(msgBuf,'(A,I9,2A)') 'SET_PARMS: selectP_inEOS_Zc=',
4382c26089 Jean*0288      &     selectP_inEOS_Zc, ' : invalid with eosType=', eosType
                0289           CALL PRINT_ERROR( msgBuf, myThid )
aa6b2555c8 Jean*0290           errCount = errCount + 1
6ef71429db Jean*0291         ENDIF
                0292       ELSE
                0293         selectP_inEOS_Zc = -1
                0294       ENDIF
809bdccbfc Jean*0295 C--   When using the dynamical pressure in EOS (with Z-coord.),
                0296 C     needs to activate specific part of the code (restart & exchange)
6ef71429db Jean*0297       storePhiHyd4Phys = selectP_inEOS_Zc.GE.2
1861cae8e7 Jean*0298 C-    pkg/atm_phys uses main-model geopotential:
6ef71429db Jean*0299       storePhiHyd4Phys = storePhiHyd4Phys .OR. useAtm_Phys
809bdccbfc Jean*0300
1cfd78e5a7 Jean*0301 C--   Adjust parameters related to length of the simulation
                0302
                0303 C-    Need to adjust endTime for sub-timestep mismatch , since in
                0304 C     several places, test for last iteration with time==endTime :
d987e9fc35 Jean*0305       tmpVar = startTime + deltaTClock*DFLOAT(nTimeSteps)
1cfd78e5a7 Jean*0306       IF ( endTime.NE.tmpVar ) THEN
                0307        IF ( ABS(endTime-tmpVar).GT.deltaTClock*1. _d -6 ) THEN
                0308         WRITE(msgBuf,'(A,A)') '** WARNING ** SET_PARMS: ',
                0309      &   '(endTime-baseTime) not multiple of time-step'
                0310         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0311      &                      SQUEEZE_RIGHT, myThid )
                0312         WRITE(msgBuf,'(2A,1PE20.13)') '** WARNING ** SET_PARMS: ',
                0313      &   'Previous endTime=', endTime
                0314         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0315      &                      SQUEEZE_RIGHT, myThid )
                0316         WRITE(msgBuf,'(2A,1PE20.13)') '** WARNING ** SET_PARMS: ',
                0317      &   'Adjusted endTime=', tmpVar
                0318         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0319      &                      SQUEEZE_RIGHT, myThid )
                0320        ENDIF
                0321        endTime = tmpVar
                0322       ENDIF
                0323
4e66ab0b67 Oliv*0324 #ifdef ALLOW_LONGSTEP
                0325       IF ( usePTRACERS ) THEN
                0326         CALL LONGSTEP_CHECK_ITERS(myThid)
                0327       ENDIF
                0328 #endif /* ALLOW_LONGSTEP */
                0329
aa6b2555c8 Jean*0330       IF ( OLx.LE.0 .OR. OLy.LE.0 ) THEN
                0331 C--   Overlap-size will be checked later in CONFIG_CHECK. This minimal
                0332 C     check here is just to set-up the model grid (INI_GRID) safely.
                0333         WRITE(msgBuf,'(2A)') 'SET_PARMS: ',
                0334      &      'model unusable with no overlap (OLx,OLy = 0)'
                0335         CALL PRINT_ERROR( msgBuf, myThid )
                0336         errCount = errCount + 1
                0337       ENDIF
                0338
                0339       IF ( errCount.GE.1 ) THEN
                0340         WRITE(msgBuf,'(A,I3,A)')
                0341      &       'SET_PARMS: detected', errCount,' fatal error(s)'
                0342         CALL PRINT_ERROR( msgBuf, myThid )
                0343         CALL ALL_PROC_DIE( 0 )
                0344         STOP 'ABNORMAL END: S/R SET_PARMS'
                0345       ENDIF
                0346
                0347 C--   After this point, main model parameters are not supposed to be modified.
809bdccbfc Jean*0348        WRITE(msgBuf,'(A,A)') 'SET_PARMS: done'
                0349        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0350      &                      SQUEEZE_RIGHT , 1)
                0351
                0352       _END_MASTER(myThid)
                0353
                0354 C--   Everyone else must wait for the parameters to be set
                0355       _BARRIER
                0356
                0357       RETURN
                0358       END