Back to home page

MITgcm
 
 

    

File indexing completed on 2026-09-07 05:08:32 UTC

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