Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:24 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
3813ebd881 Jean*0001 #include "CHEAPAML_OPTIONS.h"
f0e2fa59e3 Jean*0002 #undef CHEAPAML_OLD_MASK_SETTING
3813ebd881 Jean*0003 
                0004 CBOP
                0005 C     !ROUTINE: CHEAPAML_INIT_FIXED
                0006 C     !INTERFACE:
4fa4901be6 Nico*0007       SUBROUTINE CHEAPAML_INIT_FIXED( myThid )
                0008 
3813ebd881 Jean*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
4fa4901be6 Nico*0011 C     | SUBROUTINE CHEAPAML_INIT_FIXED
3813ebd881 Jean*0012 C     *==========================================================*
                0013 C     \ev
                0014 C     !USES:
                0015       IMPLICIT NONE
4fa4901be6 Nico*0016 
                0017 C     === Global variables ===
3813ebd881 Jean*0018 #include "EEPARAMS.h"
4fa4901be6 Nico*0019 #include "SIZE.h"
3813ebd881 Jean*0020 #include "PARAMS.h"
7e0a43f4a2 Jean*0021 #include "GRID.h"
0b40ec04c4 Jean*0022 #include "CHEAPAML.h"
3813ebd881 Jean*0023 
                0024 C     !INPUT/OUTPUT PARAMETERS:
4fa4901be6 Nico*0025 C     === Routine arguments ===
                0026 C     myThid ::  my Thread Id number
3813ebd881 Jean*0027       INTEGER myThid
7e0a43f4a2 Jean*0028 
                0029 C     !FUNCTIONS
                0030       INTEGER  ILNBLNK
                0031       EXTERNAL ILNBLNK
                0032 
                0033 C     !LOCAL VARIABLES:
                0034 C     bi,bj  :: tile indices
                0035 C     i,j    :: grid-point indices
                0036 C     msgBuf :: Informational/error message buffer
                0037 C     relaxMask :: relaxation mask [no units]
                0038 C     xgs       :: relaxation coefficient [units: 1/s]
                0039       INTEGER bi, bj
                0040       INTEGER i, j
                0041       INTEGER iG,jG
                0042       INTEGER xmw
f0e2fa59e3 Jean*0043       _RL xmf, tmpVar
7e0a43f4a2 Jean*0044       _RL relaxMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0045       _RL xgs      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0046       INTEGER iL, ioUnit
                0047       CHARACTER*(MAX_LEN_MBUF) msgBuf
f0e2fa59e3 Jean*0048 #ifdef CHEAPAML_OLD_MASK_SETTING
                0049       _RL recipMW
                0050       _RL cheapaml_taurelax, cheapaml_taurelaxocean
                0051 #endif /* CHEAPAML_OLD_MASK_SETTING */
3813ebd881 Jean*0052 CEOP
                0053 
4fa4901be6 Nico*0054 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7e0a43f4a2 Jean*0055       ioUnit = standardMessageUnit
4fa4901be6 Nico*0056 
7e0a43f4a2 Jean*0057 C--   Initialise CheapAML local & fixed variables
                0058       DO bj = myByLo(myThid), myByHi(myThid)
                0059        DO bi = myBxLo(myThid), myBxHi(myThid)
                0060         DO j=1-OLy,sNy+OLy
                0061          DO i=1-OLx,sNx+OLx
                0062           relaxMask(i,j,bi,bj) = 0. _d 0
                0063           xgs      (i,j,bi,bj) = 0. _d 0
                0064           xrelf    (i,j,bi,bj) = 0. _d 0
                0065          ENDDO
                0066         ENDDO
                0067        ENDDO
                0068       ENDDO
                0069 
f0e2fa59e3 Jean*0070 #ifdef CHEAPAML_OLD_MASK_SETTING
                0071       cheapaml_taurelax      =  cheap_tauRelax   /86400. _d 0
                0072       cheapaml_taurelaxocean =  cheap_tauRelaxOce/86400. _d 0
                0073 
7e0a43f4a2 Jean*0074 c--   Setup CheapAML mask (for relaxation):
                0075 C Do  mask
                0076       IF ( cheapMaskFile .NE. ' ') THEN
                0077          iL = ILNBLNK(cheapMaskFile)
                0078          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0079      &      'Relaxation Mask read from ->', cheapMaskFile(1:iL), '<-'
                0080          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0081          CALL READ_FLD_XY_RL( cheapMaskFile,' ',relaxMask,0,myThid )
                0082       ELSE
                0083          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0084      &      'Generate Cheapaml mask'
                0085          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0086          xmw = Cheapaml_mask_width
                0087          recipMW = ( xmw - 1 )
                0088          IF ( xmw.NE.1 ) recipMW = 1. _d 0 / recipMW
                0089          DO bj = myByLo(myThid), myByHi(myThid)
                0090           DO bi = myBxLo(myThid), myBxHi(myThid)
                0091            DO j=1,sNy
                0092             DO i=1,sNx
                0093              xmf = 0. _d 0
                0094              iG=myXGlobalLo-1+(bi-1)*sNx+i
                0095              jG = myYGlobalLo-1+(bj-1)*sNy+j
                0096              IF (jG.GT.xmw) THEN
                0097                IF (jG.LT.Ny-xmw+1) THEN
                0098                  IF (iG.LE.xmw)      xmf = 1. _d 0 - (iG-1 )*recipMW
                0099                  IF (iG.GE.Nx-xmw+1) xmf = 1. _d 0 - (Nx-iG)*recipMW
                0100                ELSE
                0101                  xmf = 1. _d 0 - (Ny-jG)*recipMW
                0102                  IF (iG.LE.xmw) THEN
                0103                    xmf =  1. _d 0 - (iG-1 )*recipMW *(Ny-jG)*recipMW
                0104                  ELSEIF (iG.GE.Nx-xmw+1) THEN
                0105                    xmf =  1. _d 0 - (Nx-iG)*recipMW *(Ny-jG)*recipMW
                0106                  ENDIF
                0107                ENDIF
                0108              ELSE
                0109                xmf = 1. _d 0 - (jG-1)*recipMW
                0110                IF (iG.LE.xmw) THEN
                0111                  xmf = 1. _d 0 - (iG-1 )*recipMW*(jG-1)*recipMW
                0112                ELSEIF (iG.GE.Nx-xmw+1) THEN
                0113                  xmf = 1. _d 0 - (Nx-iG)*recipMW*(jG-1)*recipMW
                0114                ENDIF
                0115              ENDIF
                0116              relaxMask(i,j,bi,bj) = xmf*cheapaml_taurelax
                0117             ENDDO
                0118            ENDDO
                0119           ENDDO
                0120          ENDDO
                0121       ENDIF
                0122 
                0123 C     relaxation forced on land
                0124        DO bj = myByLo(myThid), myByHi(myThid)
                0125          DO bi = myBxLo(myThid), myBxHi(myThid)
                0126            DO j=1,sNy
                0127              DO i=1,sNx
                0128                IF( maskC(i,j,1,bi,bj).EQ.0. _d 0) THEN
                0129                  relaxMask(i,j,bi,bj)=cheapaml_taurelax
                0130 C     relaxation over the ocean
                0131                ELSEIF( relaxMask(i,j,bi,bj).EQ.0. _d 0) THEN
                0132                  relaxMask(i,j,bi,bj)=cheapaml_taurelaxocean
                0133                ENDIF
                0134              ENDDO
                0135            ENDDO
                0136          ENDDO
                0137        ENDDO
                0138        _EXCH_XY_RL( relaxMask, myThid )
                0139 
                0140 C relaxation time scales from input
                0141        DO bj = myByLo(myThid), myByHi(myThid)
                0142         DO bi = myBxLo(myThid), myBxHi(myThid)
                0143          DO j=1-OLy,sNy+OLy
                0144           DO i=1-OLx,sNx+OLx
                0145            IF (relaxMask(i,j,bi,bj).NE.0.) THEN
                0146             xgs(i,j,bi,bj)=1. _d 0/relaxMask(i,j,bi,bj)/8.64 _d 4
                0147            ELSE
                0148             xgs(i,j,bi,bj)=0. _d 0
                0149            ENDIF
                0150            xrelf(i,j,bi,bj)= xgs(i,j,bi,bj)*deltaT
                0151      &                     /(1. _d 0+xgs(i,j,bi,bj)*deltaT)
                0152           ENDDO
                0153          ENDDO
                0154         ENDDO
                0155        ENDDO
f0e2fa59e3 Jean*0156 c      _EXCH_XY_RL( xgs, myThid )
                0157 c      _EXCH_XY_RL( xrelf, myThid )
                0158 
                0159 #else /* CHEAPAML_OLD_MASK_SETTING */
                0160 
                0161 C--   Setup CheapAML mask (for relaxation):
                0162       IF ( cheapMaskFile .NE. ' ' ) THEN
                0163 C-    read mask from file
                0164         iL = ILNBLNK(cheapMaskFile)
                0165         WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0166      &      'Relaxation Mask read from ->', cheapMaskFile(1:iL), '<-'
                0167         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0168         CALL READ_FLD_XY_RL( cheapMaskFile,' ',relaxMask,0,myThid )
                0169       ELSE
                0170         WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0171      &     'Generate Cheapaml mask'
                0172         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0173         DO bj = myByLo(myThid), myByHi(myThid)
                0174          DO bi = myBxLo(myThid), myBxHi(myThid)
                0175 C-    set mask according to boundaries
                0176           IF ( Cheapaml_mask_width.LE.0 .OR.
                0177      &         ( cheapamlXperiodic .AND. cheapamlYperiodic ) ) THEN
                0178             DO j=1,sNy
                0179              DO i=1,sNx
                0180                relaxMask(i,j,bi,bj) = 0.
                0181              ENDDO
                0182             ENDDO
                0183           ELSE
                0184             xmw = Cheapaml_mask_width
                0185             tmpVar = xmw
                0186             tmpVar = oneRL / tmpVar
                0187             DO j=1,sNy
                0188              DO i=1,sNx
                0189               xmf = 0. _d 0
                0190               iG = myXGlobalLo-1+(bi-1)*sNx+i
                0191               jG = myYGlobalLo-1+(bj-1)*sNy+j
                0192               IF ( .NOT.cheapamlXperiodic ) THEN
                0193                 IF (iG.LE.xmw)      xmf = oneRL - (iG-1 )*tmpVar
                0194                 IF (iG.GE.Nx-xmw+1) xmf = oneRL - (Nx-iG)*tmpVar
                0195               ENDIF
                0196               IF ( .NOT.cheapamlYperiodic ) THEN
                0197                 IF (jG.LE.xmw)
                0198      &                    xmf = MAX( xmf, oneRL - (jG-1 )*tmpVar )
                0199                 IF (jG.GE.Ny-xmw+1)
                0200      &                    xmf = MAX( xmf, oneRL - (Ny-jG)*tmpVar )
                0201               ENDIF
                0202               relaxMask(i,j,bi,bj) = xmf
                0203              ENDDO
                0204             ENDDO
                0205           ENDIF
                0206 C-    set mask to one over land:
                0207           DO j=1,sNy
                0208             DO i=1,sNx
                0209               relaxMask(i,j,bi,bj) = MAX( relaxMask(i,j,bi,bj),
                0210      &                               (oneRL - maskC(i,j,1,bi,bj)) )
                0211             ENDDO
                0212           ENDDO
                0213          ENDDO
                0214         ENDDO
                0215       ENDIF
                0216       _EXCH_XY_RL( relaxMask, myThid )
7e0a43f4a2 Jean*0217 
f0e2fa59e3 Jean*0218 C-    Set relaxation coeff "xgs"
                0219       DO bj = myByLo(myThid), myByHi(myThid)
                0220        DO bi = myBxLo(myThid), myBxHi(myThid)
                0221          IF ( cheap_tauRelax .LE. zeroRL ) THEN
                0222            DO j=1-OLy,sNy+OLy
                0223             DO i=1-OLx,sNx+OLx
                0224               xgs(i,j,bi,bj) = 0. _d 0
                0225             ENDDO
                0226            ENDDO
                0227          ELSE
                0228            tmpVar =  oneRL/cheap_tauRelax
                0229            DO j=1-OLy,sNy+OLy
                0230             DO i=1-OLx,sNx+OLx
                0231               xgs(i,j,bi,bj) = relaxMask(i,j,bi,bj)*tmpVar
                0232             ENDDO
                0233            ENDDO
                0234          ENDIF
                0235          IF ( cheap_tauRelaxOce .GT. zeroRL
                0236      &        .AND. cheapMaskFile .EQ. ' ' ) THEN
                0237            tmpVar =  oneRL/cheap_tauRelaxOce
                0238            DO j=1-OLy,sNy+OLy
                0239             DO i=1-OLx,sNx+OLx
                0240               xgs(i,j,bi,bj) = MAX( xgs(i,j,bi,bj), tmpVar )
                0241             ENDDO
                0242            ENDDO
                0243          ENDIF
                0244 C-    Calculate implicit relaxation factor "xrelf"
                0245          DO j=1-OLy,sNy+OLy
                0246           DO i=1-OLx,sNx+OLx
                0247             tmpVar = xgs(i,j,bi,bj)*deltaT
                0248             xrelf(i,j,bi,bj)= tmpVar/( oneRL + tmpVar )
                0249           ENDDO
                0250          ENDDO
                0251        ENDDO
                0252       ENDDO
                0253 #endif /* CHEAPAML_OLD_MASK_SETTING */
7e0a43f4a2 Jean*0254 
                0255       IF ( debugLevel.GE.debLevB .AND. nIter0.EQ.0 ) THEN
                0256         CALL WRITE_FLD_XY_RL('CheapMask',  ' ', relaxMask, 0, myThid )
                0257       ENDIF
                0258       IF ( debugLevel.GE.debLevC .AND. nIter0.EQ.0 ) THEN
                0259         CALL WRITE_FLD_XY_RL('Cheap_xgs',   ' ', xgs,   0, myThid )
                0260         CALL WRITE_FLD_XY_RL('Cheap_xrelf', ' ', xrelf, 0, myThid )
4fa4901be6 Nico*0261       ENDIF
                0262 
0b40ec04c4 Jean*0263       _BEGIN_MASTER( myThid )
                0264 
                0265 C-    Initialise AB starting level
                0266       cheapTairStartAB = nIter0
                0267       cheapQairStartAB = nIter0
                0268       cheapTracStartAB = nIter0
                0269 
                0270       _END_MASTER( myThid )
                0271 
                0272 C-    Everyone else must wait for parameters to be set
                0273       _BARRIER
                0274 
7e0a43f4a2 Jean*0275 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0276 
                0277 #ifdef ALLOW_MNC
                0278 c     IF (useMNC) THEN
                0279 c     ENDIF
                0280 #endif /* ALLOW_MNC */
                0281 
                0282 #ifdef ALLOW_DIAGNOSTICS
                0283       IF ( useDiagnostics ) THEN
                0284         CALL CHEAPAML_DIAGNOSTICS_INIT( myThid )
                0285       ENDIF
                0286 #endif
                0287 
3813ebd881 Jean*0288       RETURN
                0289       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!